###################################################################################################.
###                                                                                             ###
###     Why Is It So Hard to Counteract Wealth Inequality? Evidence from the United Kingdom     ###
###     World Politics                                                                          ###
###                                                                                             ###
###     Elkjær, Ansell, Bokobza, Cansunar, Haslberger, & Nyrup                                  ###
###                                                                                             ###
###     Main Analysis                                                                           ###
###                                                                                             ###
###################################################################################################.

rm(list = ls())

pacman::p_load(tidyverse,haven,ggplot2,gridExtra,estimatr,ggeffects,cregg,expss,stargazer,arm,here,ggtext,contrast,khroma,cobalt,scales)

source("00_helperfunctions.r")

###
# Loading data  ----
###

df.rates <- read_rds("df_inh_database.rds")

df.wide <- read_rds("df_main.rds")

df.conjoint <- read_rds("df_conjoint.rds")

df.experiment <- read_rds("df_experiment.rds")

# Main analysis ----

###
## Figure 1: Marginal Inheritance Tax Rates by Multiple of GDP/Capita in 18 Advanced Democracies ----
###

f1 <- df.rates %>% 
  filter(year < 2020) %>% 
  mutate(rate_top = ifelse(is.na(rate_top), 0, rate_top),
         rate_lowest = ifelse(is.na(rate_lowest), 0, rate_lowest), # replace NA by 0
         ratio_top_low = rate_top/rate_lowest, 
         ratio_1000_1 = rate_1000xgdp/rate_1xgdp)

f1_2 <- f1 %>% 
  group_by(year) %>% 
  summarise_if(is.numeric, mean, na.rm = TRUE) # data with mean rates across countries by year

rates_smooth <- ggplot(data = f1_2) + 
  geom_smooth(aes(x = year, y = rate_1000xgdp), color="red", span=0.1, se=FALSE) +
  geom_smooth(aes(x = year, y = rate_100xgdp), color="orange", span=0.1, se=FALSE) +
  geom_smooth(aes(x = year, y = rate_50xgdp), color="yellow", span=0.1, se=FALSE) +
  geom_smooth(aes(x = year, y = rate_10xgdp), color="green", span=0.1, se=FALSE) +
  geom_smooth(aes(x = year, y = rate_5xgdp), color="blue", span=0.1, se=FALSE) +
  geom_smooth(aes(x = year, y = rate_1xgdp), color="purple", span=0.1, se=FALSE) +
  annotate(geom="text", x=1942, y=26, label="1000x", color="#555555",
           size=4) +
  annotate(geom="text", x=1942, y=13, label="100x", color="#555555",
           size=4) +
  annotate(geom="text", x=1942, y=9.4, label="50x", color="#555555",
           size=4) +
  annotate(geom="text", x=1942, y=4.2, label="10x", color="#555555",
           size=4) +
  annotate(geom="text", x=1942, y=2.8, label="5x", color="#555555",
           size=4) +
  annotate(geom="text", x=1942, y=1.1, label="1x", color="#555555",
           size=4) +
  labs(x = "", 
       y = "Marginal inheritance tax rate (%)", 
       title = "")+
  scale_x_continuous(limits = c(1940, 2020))+
  scale_y_continuous(limits = c(0, 40))+ 
  theme_minimal()+
  theme(axis.text=element_text(size=12),
        axis.title=element_text(size=14))

ggsave("Output/figure1.pdf",
       width = 150, height = 150, units = "mm")

###
## Figure 2: Preferences over Inheritance Taxation ----
###

# Mean age by parents house price group

df.wide <- df.wide %>% 
  mutate(not_applicable  = case_when(house_rent_groups_parents2=="Not applicable/deceased"~1,
                                     TRUE ~0))

df.wide %>%
  group_by(not_applicable) %>%  
  summarise(mean = mean(age))

f2_1 <- plot_canvas_figure1(df = df.wide, q = df.wide$Q37_1, labs = "Overall level")

f2_2 <- plot_canvas_figure1(df = df.wide, q = df.wide$Q37_5, labs = "Tax you might pay")

f2_3 <- plot_canvas_figure1(df = df.wide, q = df.wide$Q37_6, labs = "Tax your heirs might pay")

f2_4 <- plot_canvas_figure1(df = df.wide, q = df.wide$Q37_4, labs = "Inheritances under £325k")

f2_5 <- plot_canvas_figure1(df = df.wide, q = df.wide$Q37_3, labs = "Inheritances £325k-£1m")

f2_6 <- plot_canvas_figure1(df = df.wide, q = df.wide$Q37_2, labs = "Inheritances above £1m")

# Print figure

figure2 <- gridExtra::grid.arrange(f2_1, f2_2, f2_3, f2_4, f2_5, f2_6, ncol=3)

ggsave("Output/figure2.pdf",
       figure2,
       width = 550, height = 275, units = "mm")

###
## Table 1: Determinants of Expressing An Opinion about The Overall Level of Inheritance Taxes ----
###

## LPM

tab1_LPM <- lm(inh_overall_dk ~ as.factor(house_rent_groups)+as.factor(house_rent_groups_parents2)+hh_income+age+female+degree, 
              data=df.wide)


## Logistic

tab1_logit <- glm(inh_overall_dk ~ as.factor(house_rent_groups)+as.factor(house_rent_groups_parents2)+hh_income+age+female+degree, 
                 data=df.wide, family=binomial(link="logit"))


# Table

stargazer(tab1_LPM, tab1_logit,  type="latex",
          title = "Determinants of registering an opinion on question about overall inheritance tax rates",
          model.names = FALSE,
          keep.stat = c("n", "rsq"), 
          covariate.labels = c("/hspace{2mm} £100k and under",
                               "/hspace{2mm} £100k to £200k",
                               "/hspace{2mm} £200k to £300k",
                               "/hspace{2mm} £300k to £400k",
                               "/hspace{2mm} £400k to £500k",
                               "/hspace{2mm} £500k to £750k",
                               "/hspace{2mm} £750k and up",
                               "/hspace{2mm} Not applicable/deceased",
                               "/hspace{2mm} £200k and under",
                               "/hspace{2mm} £200k to £400k",
                               "/hspace{2mm} £400k to £600k",
                               "/hspace{2mm} £600k and up",
                               "/hspace{2mm} Household income",
                               "/hspace{2mm} Age",
                               "/hspace{2mm} Female",
                               "/hspace{2mm} University degree"),
          no.space=TRUE,
          star.char = c("*"), star.cutoffs = c(0.05),
          out = "Output/table1.tex"
          ) 

###
## Figure 3: High-Wealth Individuals Are More Likely To Express A Preference over Inheritance Taxation ----
###

group <- c("1", "2")
xb.low.social.scale2 <- tab1_logit$coef[1] + tab1_logit$coef[2]*0 +tab1_logit$coef[3]*0 + tab1_logit$coef[4]*0 + tab1_logit$coef[5]*0 + tab1_logit$coef[6]*0 + tab1_logit$coef[7]*0 + tab1_logit$coef[8]*0 + tab1_logit$coef[9]*0 + tab1_logit$coef[10]*0 + tab1_logit$coef[11]*0 + tab1_logit$coef[12]*0 + tab1_logit$coef[13]*0 + tab1_logit$coef[14]*1  + tab1_logit$coef[15]*mean(df.wide$age) + tab1_logit$coef[16]*1 + tab1_logit$coef[17]*0
xb.high.social.scale2 <- tab1_logit$coef[1] + tab1_logit$coef[2]*0 +tab1_logit$coef[3]*0 + tab1_logit$coef[4]*0 + tab1_logit$coef[5]*0 + tab1_logit$coef[6]*0 + tab1_logit$coef[7]*0 + tab1_logit$coef[8]*1 + tab1_logit$coef[9]*0 + tab1_logit$coef[10]*0 + tab1_logit$coef[11]*0 + tab1_logit$coef[12]*0 + tab1_logit$coef[13]*1 + tab1_logit$coef[14]*15  + tab1_logit$coef[15]*mean(df.wide$age) + tab1_logit$coef[16]*0 + tab1_logit$coef[17]*1

xb.low.social.scale.pred2 <- invlogit(xb.low.social.scale2)
xb.high.social.scale.pred2 <- invlogit(xb.high.social.scale2)

pp2 <- c(xb.low.social.scale.pred2, xb.high.social.scale.pred2)

df.xb2 <- data.frame(group, pp2)

figure3 <- ggplot(df.xb2, aes(y=pp2, x=group)) + 
  geom_bar(position="dodge", stat="identity",color=onecolour, fill = onecolour)+
  scale_y_continuous("Predicted percentage of answering", breaks = c(0,0.2,.4,.6,.8,1), limits = c(0, 1),labels = scales::percent_format(accuracy = 1))+
  scale_x_discrete("Wealth status", breaks=c(1,2), labels=c("Low", "High"))+
  theme_minimal()+
  theme(axis.text=element_text(size=20),
        axis.title=element_text(size=20),
        title=element_text(size=22),
        panel.border = element_blank(), panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(), axis.line = element_line(colour = "black")) +
  labs(title = "")

ggsave("Output/figure3.pdf",
       figure3,
       width = 200, height = 200, units = "mm")

###
## Figure 4: The Relationship between Current/Future Housing Wealth and Views that Inheritance Taxation is Too High ----
###

### Left side
## overall level of taxes, your taxes, you heirs' taxes

inh_overall_fig4 <- lm(inh_overalld ~ house_rent_groups+house_rent_groups_parents2+hh_income+age+female+degree, 
                        data=df.wide)

inh_you_pay_fig4 <- lm(inh_you_payd ~ house_rent_groups + house_rent_groups_parents2 + hh_income+age+female+degree,  
                        data=df.wide)

inh_heirs_pay_fig4 <- lm(inh_heirs_payd ~ house_rent_groups + house_rent_groups_parents2 + hh_income+age+female+degree,   
                          data=df.wide)

# Figure 4 - Linear

inh_overall_tidy_fig4 <- inh_overall_fig4 %>% tidy()

coef_inh_overall_fig4 <- getcoef(model_name = "Overall level", reg = inh_overall_tidy_fig4)

inh_you_pay_tidy_fig4 <- inh_you_pay_fig4 %>% tidy()

coef_inh_you_pay_fig4 <- getcoef(model_name = "You pay", reg = inh_you_pay_tidy_fig4)

inh_heirs_pay_tidy_fig4 <- inh_heirs_pay_fig4 %>% tidy()

coef_inh_heirs_pay_fig4 <- getcoef(model_name = "Heirs pay", reg = inh_heirs_pay_tidy_fig4)

# Coef combined

coefcombined_figure5_fig4 <- rbind(coef_inh_overall_fig4,coef_inh_you_pay_fig4,coef_inh_heirs_pay_fig4) %>%
  mutate(group = factor(group, levels = c("Overall level","You pay","Heirs pay")))

fig4_left <- plot_canvas_coefficient(df = coefcombined_figure5_fig4,
                                             face = coefcombined_figure5_fig4$bold,
                                             x = reorder(coefcombined_figure5_fig4$model, desc(coefcombined_figure5_fig4$model)),
                                             models = reorder(coefcombined_figure5_fig4$group, desc(coefcombined_figure5_fig4$group)),
                                             cols = threecolours) + ylim(-0.2,0.4)

### Right side
## Low level of taxes, medium taxes, high' taxes

inh_low_fig4 <- lm(inh_lowd ~ house_rent_groups + house_rent_groups_parents2 +hh_income+age+female+degree, 
                    data=df.wide)

inh_moderate_fig4 <- lm(inh_moderated ~ house_rent_groups+house_rent_groups_parents2+hh_income+age+female+degree,  
                         data=df.wide)

inh_high_fig4 <- lm(inh_highd ~ house_rent_groups + house_rent_groups_parents2 +hh_income+age+female+degree,   
                     data=df.wide)

inh_low_tidy_fig4 <- inh_low_fig4 %>% tidy()

coef_inh_low_fig4 <- getcoef(model_name = "<£325k", reg = inh_low_tidy_fig4)

inh_moderate_tidy_fig4 <- inh_moderate_fig4 %>% tidy()

coef_inh_moderate_fig4 <- getcoef(model_name = "£325k-£1m", reg = inh_moderate_tidy_fig4)

inh_high_tidy_fig4 <- inh_high_fig4 %>% tidy()

coef_inh_high_fig4 <- getcoef(model_name = ">£1m", reg = inh_high_tidy_fig4)

# Coef combined

coefcombined_figure6_fig4 <- rbind(coef_inh_low_fig4,coef_inh_moderate_fig4,coef_inh_high_fig4) %>%
  mutate(group = factor(group, levels = c("<£325k","£325k-£1m",">£1m")))

fig4_right <- plot_canvas_coefficient(df = coefcombined_figure6_fig4,
                                             face = coefcombined_figure6_fig4$bold,
                                             x = reorder(coefcombined_figure6_fig4$model, desc(coefcombined_figure6_fig4$model)),
                                             models = reorder(coefcombined_figure6_fig4$group, desc(coefcombined_figure6_fig4$group)),
                                             cols = threecolours)

figure4 <- gridExtra::grid.arrange(fig4_left, fig4_right, ncol=2)

ggsave("Output/figure4.pdf",
       figure4,
       width = 800, height = 600, units = "mm")

###
## Figure 5: Preferred Tax Rates on Different-Sized Inheritances ----
###

reg_conjoint <-  chose_plan_inh ~ factor_inheritance_gr1 + factor_inheritance_gr2 + factor_inheritance_gr3 + factor_inheritance_gr4

figure5 <- plot(mm(df.conjoint, reg_conjoint, id= ~id), vline=0.5)+ 
  ggplot2::scale_x_continuous(
    limits = c(0.3, 0.7), 
    breaks = c(0.3, 0.4, 0.5, 0.6, 0.7)
  ) + 
  ggplot2::geom_text(
    aes(label = ifelse(is.na(std.error), "", sprintf("%0.2f (%0.2f)", estimate, std.error))),
    colour = "black", 
    size = 3.5,
    position = position_nudge(y = .3)) + 
  ggplot2::geom_point(size = 2) +
  theme(legend.position="none",
        axis.text=element_text(size=12),
        axis.title=element_text(size=12)) +
  scale_colour_manual(values = fourcolours)

ggsave("Output/figure5.pdf",
       figure5,
       width = 125, height = 175, units = "mm")

###
## Figure 6: Preferred Tax Rates on Different-Sized Inheritances, by Value of Own and Parents’ Properties ----
###

cj_fig6_1 <- cj(df.conjoint, chose_plan_inh ~ factor_inheritance_gr1 + factor_inheritance_gr2 + factor_inheritance_gr3 + factor_inheritance_gr4, id = ~id, estimate = "mm", by = ~factor_house_price_group)

fig6_plot1 <- plot(cj_fig6_1,
                         group = "factor_house_price_group",
                         vline = 0.5,
                         size = 2
                         ) +
                        ggplot2::scale_x_continuous(
                        limits = c(0.25, 0.75), 
                        breaks = c(0.3, 0.4, 0.5, 0.6, 0.7)) +
                  theme(legend.title=element_text(size=10),
                        legend.text=element_text(size=10),
                        axis.text=element_text(size=12),
                        axis.title=element_text(size=12)) +
                        scale_color_manual(
                        values=fourcolours,
                        guide = guide_legend(reverse = FALSE),
                        breaks = c("Don't own","£125k-£500k","<£125k",">£500k")) +
                  guides(color = guide_legend(title="Value of\nown\nhouse:",
                         nrow = 2,
                         reverse = FALSE))

cj_fig6_2 <- cj(df.conjoint, chose_plan_inh ~ factor_inheritance_gr1 + factor_inheritance_gr2 + factor_inheritance_gr3 + factor_inheritance_gr4, id = ~id, estimate = "mm", by = ~factor_house_price_group_parents)

fig6_plot2 <- plot(cj_fig6_2,
                             group = "factor_house_price_group_parents",
                                 vline = 0.5,
                                 size = 2
                                 ) +
                                 ggplot2::scale_x_continuous(
                                limits = c(0.25, 0.75), 
                                breaks = c(0.3, 0.4, 0.5, 0.6, 0.7))+
                                theme(
                                      legend.title=element_text(size=10),
                                      legend.text=element_text(size=10),
                                      axis.text=element_text(size=12),
                                      axis.title=element_text(size=12)) +
                                scale_color_manual(
                                      values = fivecolours,
                                      guide = guide_legend(reverse = FALSE),
                                      breaks = c("NA/deceased","Don't own","<£125k","£125k-£500k",">£500k")) +
                                guides(color = guide_legend(title="Value of \nparents'\nhouse:",
                                       nrow = 3,
                                       reverse = FALSE))

fig6 <- gridExtra::grid.arrange(fig6_plot1, fig6_plot2, ncol=2) 

ggsave("Output/figure6.pdf",
       fig6,
       width = 270, height = 255, units = "mm")

###
## Figure 7: Preferred Tax Rates on Different-Sized Inheritances, by Don’t Know-Status ----
###

figure7_dk <- cj(df.conjoint, chose_plan_inh ~ factor_inheritance_gr1 + factor_inheritance_gr2 + factor_inheritance_gr3 + factor_inheritance_gr4 , id = ~id, estimate = "mm", by = ~factor_inh_overall_dk)

figure7 <- plot(figure7_dk, group = "factor_inh_overall_dk", vline = 0.5)+
  scale_colour_manual(limits = levels(figure7_dk$factor_inh_overall_dk),
                      values = twocolours)+
  guides(color = guide_legend(title="Response to\nquestion about\noverall inheritance\ntax rate:", nrow = 1))+
  ggplot2::scale_x_continuous(
    limits = c(0.35, 0.65), 
    breaks = c(0.4, 0.5, 0.6))+
  theme(legend.title=element_text(size=10),
        legend.text=element_text(size=10),
        axis.title=element_text(size=12),
        axis.text=element_text(size=12))

ggsave("Output/figure7.pdf",
       figure7,
       width = 145, height = 175, units = "mm")

###
## Figure 8: The Effect of the Information Treatment on Inheritance Tax Preferences ----
###

# Overall
fig8_inh_o <- lm(inh_overalld ~ as.factor(Qtreatment), 
            data=df.wide)

# Yours
fig8_inh_y <- lm(inh_you_payd ~ as.factor(Qtreatment), 
            data=df.wide)

# Heirs

fig8_inh_h <- lm(inh_heirs_payd ~ as.factor(Qtreatment), 
            data=df.wide)

# Low

fig8_inh_low <- lm(inh_lowd ~ as.factor(Qtreatment), 
              data=df.wide)

# Mid

fig8_inh_moderate <- lm(inh_moderated ~ as.factor(Qtreatment), 
                   data=df.wide)

# High

fig8_inh_high <- lm(inh_highd ~ as.factor(Qtreatment), 
               data=df.wide)

inh_o_tidy <- fig8_inh_o %>% broom::tidy()
inh_y_tidy <- fig8_inh_y %>% broom::tidy()
inh_h_tidy <- fig8_inh_h %>% broom::tidy()
inh_low_tidy <- fig8_inh_low %>% broom::tidy()
inh_moderate_tidy <- fig8_inh_moderate %>% broom::tidy()
inh_high_tidy <- fig8_inh_high %>% broom::tidy()

# Create tibble

tibblefigure8 <- tibble(model = c(rep("Overall level",2),rep("You might pay",2),
                                   rep("Your heirs might pay",2),rep("<£325k",2),
                                   rep("£325-£1m",2),rep(">£1m",2)),
                         group= c(rep(c("National","National + Local"),6)),
                         estimate = c(inh_o_tidy$estimate[2],inh_o_tidy$estimate[3],
                                      inh_y_tidy$estimate[2],inh_y_tidy$estimate[3],
                                      inh_h_tidy$estimate[2],inh_h_tidy$estimate[3],
                                      inh_low_tidy$estimate[2],inh_low_tidy$estimate[3],
                                      inh_moderate_tidy$estimate[2],inh_moderate_tidy$estimate[3],
                                      inh_high_tidy$estimate[2],inh_high_tidy$estimate[3]),
                         stderror = c(inh_o_tidy$std.error[2],inh_o_tidy$std.error[3],
                                      inh_y_tidy$std.error[2],inh_y_tidy$std.error[3],
                                      inh_h_tidy$std.error[2],inh_h_tidy$std.error[3],
                                      inh_low_tidy$std.error[2],inh_low_tidy$std.error[3],
                                      inh_moderate_tidy$std.error[2],inh_moderate_tidy$std.error[3],
                                      inh_high_tidy$std.error[2],inh_high_tidy$std.error[3]),
                         bold = c(rep("plain",12))) %>% 
  mutate(model = factor(model, levels = c("Overall level",
                                          "You might pay",
                                          "Your heirs might pay",
                                          "<£325k",
                                          "£325-£1m",
                                          ">£1m")))

fig8 <- plot_canvas_coefficient(df = tibblefigure8,
                                 x = reorder(tibblefigure8$model, desc(tibblefigure8$model)),
                                 models = reorder(tibblefigure8$group, desc(tibblefigure8$group)),
                                 cols = twocolours) + 
                                ylim(-0.1,0.1) +
                           labs(y="Coefficient estimate")

ggsave("Output/figure8.pdf",
       fig8,
       width = 250, height = 325, units = "mm")

###
## Figure 9: The Effect of the Information Treatment on Inheritance Tax Preferences, by Own (Top Panel) and Parents’ (Bottom Panel) Homeownership Status ----
###

## Own house

# Overall

inh_o_d <- lm(inh_overalld ~ as.factor(Qtreatment)*house_rent_2groups, data=df.wide)

ownhouse_overall_d_out <- contrast_information_conditional(inh_o_d,facettext = "Overall level")

# Yours

inh_y_d <- lm(inh_you_payd ~ as.factor(Qtreatment)*house_rent_2groups,data=df.wide)

ownhouse_you_d_out <- contrast_information_conditional(inh_y_d,facettext = "You might pay")

# Heirs

inh_h_d <- lm(inh_heirs_payd ~ as.factor(Qtreatment)*house_rent_2groups,data=df.wide)

ownhouse_heirs_d_out <- contrast_information_conditional(inh_h_d,facettext = "Your heirs might pay")

# Low

inh_low_d <- lm(inh_lowd ~ as.factor(Qtreatment)*house_rent_2groups,data=df.wide)

ownhouse_low_d_out <- contrast_information_conditional(inh_low_d,facettext = "<£325k")

# Mid

inh_moderate_d <- lm(inh_moderated ~ as.factor(Qtreatment)*house_rent_2groups,data=df.wide)

ownhouse_mid_d_out <- contrast_information_conditional(inh_moderate_d,facettext = "£325k-£1m")

# High

inh_high_d <- lm(inh_highd ~ as.factor(Qtreatment)*house_rent_2groups,data=df.wide)

ownhouse_high_d_out <- contrast_information_conditional(inh_high_d,facettext = ">£1m")

# Bind results

cond <- rbind(ownhouse_overall_d_out,ownhouse_you_d_out,ownhouse_heirs_d_out,ownhouse_low_d_out,ownhouse_mid_d_out,ownhouse_high_d_out) %>% 
  mutate(model = fct_relevel(model,c("National+Local","National")),
         group = fct_relevel(group,c("Own","Don't own")),
         facettext = fct_relevel(facettext,c("Overall level","You might pay","Your heirs might pay","<£325k","£325k-£1m",">£1m")))


plot_home_d <- plot_canvas_coefficient_experiment(df = cond,givemebreaks = c("National+Local","National")) + theme(legend.position = "none") + scale_y_continuous(breaks=c(-0.2,0,0.2), lim = c(-0.35,0.35))

## Parent's house

# Overall

inh_o_d <- lm(inh_overalld ~ as.factor(Qtreatment)*house_rent_3groups_parents, data=df.wide)

parents_overall_d_out <- contrast_information_conditional(inh_o_d,facettext = "Overall level", parents = TRUE)

# Yours

inh_y_d <- lm(inh_you_payd ~ as.factor(Qtreatment)*house_rent_3groups_parents, data=df.wide)

parents_you_d_out <- contrast_information_conditional(inh_y_d,facettext = "You might pay", parents = TRUE)

# Heirs

inh_h_d <- lm(inh_heirs_payd ~ as.factor(Qtreatment)*house_rent_3groups_parents, data=df.wide)

parents_heirs_d_out <- contrast_information_conditional(inh_h_d,facettext = "Your heirs might pay", parents = TRUE)

# Low

inh_low_d <- lm(inh_lowd ~ as.factor(Qtreatment)*house_rent_3groups_parents, data=df.wide)

parents_low_d_out <- contrast_information_conditional(inh_low_d,facettext = "<£325k", parents = TRUE)

# Mid

inh_moderate_d <- lm(inh_moderated ~ as.factor(Qtreatment)*house_rent_3groups_parents, data=df.wide)

parents_mid_d_out <- contrast_information_conditional(inh_moderate_d,facettext = "£325k-£1m", parents = TRUE)

# High

inh_high_d <- lm(inh_highd ~ as.factor(Qtreatment)*house_rent_3groups_parents, data=df.wide)

parents_high_d_out <- contrast_information_conditional(inh_high_d,facettext = ">£1m", parents = TRUE)

cond <- rbind(parents_overall_d_out,parents_you_d_out,parents_heirs_d_out,parents_low_d_out,parents_mid_d_out,parents_high_d_out) %>% 
  mutate(model = fct_relevel(model,c("National+Local","National")),
         group = fct_relevel(group,c("Own","Not applicable/deceased","Don't own")),
         facet = fct_relevel(facettext,c("Overall level","You might pay","Your heirs might pay","<£325k","£325k-£1m",">£1m")),
         group = dplyr::recode(group, "Not applicable/deceased" = "NA/\ndeceased"))


plot_parents_d <- plot_canvas_coefficient_experiment(df = cond,givemebreaks = c("National+Local","National")) + theme(legend.position = "none") + scale_y_continuous(breaks=c(-0.2,0,0.2), lim = c(-0.35,0.35))

figure9 <- gridExtra::grid.arrange(plot_home_d, plot_parents_d, ncol=1,heights=c(8,10))

ggsave("Output/figure9.pdf",
       figure9,
       width = 550, height = 500, units = "mm")


###
## Figure 10: The Effect of the Priming Treatment on Inheritance Tax Preferences ----
###

# Overall

inh_overall_d_linear <- lm_robust(inh_overall_d ~ framing_treatment + info_treatment, data = df.experiment)

# You

inh_you_d_linear <- lm_robust(inh_you_d ~ framing_treatment + info_treatment, data = df.experiment)

# Heirs pay

inh_heirs_d_linear <- lm_robust(inh_heirs_d ~ framing_treatment + info_treatment, data = df.experiment)

# <£325k

inh_low_d_linear <- lm_robust(inh_low_d ~ framing_treatment + info_treatment, data = df.experiment)

# £325k-£1m

inh_mid_d_linear <- lm_robust(inh_mid_d ~ framing_treatment + info_treatment, data = df.experiment)

# >1£m

inh_high_d_linear <- lm_robust(inh_high_d ~ framing_treatment + info_treatment, data = df.experiment)

# Option 1: Coefficient plots

out_overall <- getcoef_experiment(model_name = "Overall level", reg = inh_overall_d_linear)

out_you <- getcoef_experiment(model_name = "You might pay", reg = inh_you_d_linear)

out_heirs <- getcoef_experiment(model_name = "You heirs might pay", reg = inh_heirs_d_linear)

out_low <- getcoef_experiment(model_name = "£325k", reg = inh_low_d_linear)

out_mid <- getcoef_experiment(model_name = "£325k-£1m", reg = inh_mid_d_linear)

out_high <- getcoef_experiment(model_name = "£1m", reg = inh_high_d_linear)

experiment_combined <- rbind(out_overall,out_you,out_heirs,out_low,out_mid,out_high)

figure10 <- plot_canvas_coefficient_experiment2(df = experiment_combined,
                                               x = fct_relevel(experiment_combined$group,"£1m","£325k-£1m","£325k","You heirs might pay","You might pay","Overall level"),
                                               models = reorder(experiment_combined$model, desc(experiment_combined$model)),
                                               cols = threecolours,
                                               face = rep("plain",nrow(experiment_combined))) + 
  ylim(-0.2,0.2)

ggsave("Output/figure10.pdf",
       figure10,
       width = 250, height = 200, units = "mm")

###
## Figure 11: The Effect of the Priming Treatment on Inheritance Tax Preferences, by Own (Top Panel) and Parents’ (Bottom Panel) Homeownership Status ----
###

## Top plot ---

# Overall level

cond_ownhouse_overall_d <- lm(inh_overall_d ~ framing_treatment*homeowner + info_treatment,data=df.experiment)

ownhouse_overall_d_out <- contrast_conditional(reg = cond_ownhouse_overall_d,facettext = "Overall level")

# You

cond_ownhouse_you_d <- lm(inh_you_d ~ framing_treatment*homeowner + info_treatment, data = df.experiment)

ownhouse_you_d_out <- contrast_conditional(reg = cond_ownhouse_you_d,facettext = "You might pay")

# Heirs pay

cond_ownhouse_heirs_d <- lm(inh_heirs_d ~ framing_treatment*homeowner + info_treatment, data = df.experiment)

ownhouse_heirs_d_out <- contrast_conditional(reg = cond_ownhouse_heirs_d,facettext = "Your heirs might pay")

# <£325k

cond_ownhouse_low_d <- lm(inh_low_d ~ framing_treatment*homeowner + info_treatment, data = df.experiment)

ownhouse_low_d_out <- contrast_conditional(reg = cond_ownhouse_low_d,facettext = "<£325k")

# £325k-£1m

cond_ownhouse_mid_d <- lm(inh_mid_d ~ framing_treatment*homeowner + info_treatment, data = df.experiment)

ownhouse_mid_d_out <- contrast_conditional(reg = cond_ownhouse_mid_d,facettext = "£325k-£1m")

# >1£m

cond_ownhouse_high_d <- lm(inh_high_d ~ framing_treatment*homeowner + info_treatment, data = df.experiment) 

ownhouse_high_d_out <- contrast_conditional(reg = cond_ownhouse_high_d,facettext = ">£1m")

# Bind results

cond <- rbind(ownhouse_overall_d_out,ownhouse_you_d_out,ownhouse_heirs_d_out,ownhouse_low_d_out,ownhouse_mid_d_out,ownhouse_high_d_out) %>% 
  mutate(model = fct_relevel(model,c("Taxes and public goods","Equality of opportunity","Death/Double tax")),
         group = fct_relevel(group,c("Own","Don't own")),
         facet = fct_relevel(facettext,c("Overall level","You might pay","Your heirs might pay","<£325k","£325k-£1m",">£1m")))

# Plot

plot_home_d <- plot_canvas_coefficient_experiment(df = cond) + theme(legend.position = "none") + scale_y_continuous(breaks=c(-0.2,0,0.2), lim = c(-0.35,0.35))

## Bottom plot ---

# Overall level

cond_parents_overall_d <- lm(inh_overall_d ~ framing_treatment*house_rent_groups_parents2 + info_treatment, 
                             data=df.experiment)

parents_overall_d_out <- contrast_conditional(reg = cond_parents_overall_d,facettext = "Overall level",parents = TRUE)

# You

cond_parents_you_d <- lm(inh_you_d ~ framing_treatment*house_rent_groups_parents2 + info_treatment, data = df.experiment)

parents_you_d_out <- contrast_conditional(reg = cond_parents_you_d,facettext = "You might pay",parents = TRUE)

# Heirs pay

cond_parents_heirs_d <- lm(inh_heirs_d ~ framing_treatment*house_rent_groups_parents2 + info_treatment, data = df.experiment)

parents_heirs_d_out <- contrast_conditional(reg = cond_parents_heirs_d,facettext = "Your heirs might pay",parents = TRUE)

# <£325k

cond_parents_low_d <- lm(inh_low_d ~ framing_treatment*house_rent_groups_parents2 + info_treatment, data = df.experiment)

parents_low_d_out <- contrast_conditional(reg = cond_parents_low_d,facettext = "<£325k",parents = TRUE)

# £325k-£1m

cond_parents_mid_d <- lm(inh_mid_d ~ framing_treatment*house_rent_groups_parents2 + info_treatment, data = df.experiment)

parents_mid_d_out <- contrast_conditional(reg = cond_parents_mid_d,facettext = "£325k-£1m",parents = TRUE)

# >1£m

cond_parents_high_d <- lm(inh_high_d ~ framing_treatment*house_rent_groups_parents2 + info_treatment, data = df.experiment) 

parents_high_d_out <- contrast_conditional(reg = cond_parents_high_d,facettext = ">£1m",parents = TRUE)

# Bind results

cond <- rbind(parents_overall_d_out,parents_you_d_out,parents_heirs_d_out,parents_low_d_out,parents_mid_d_out,parents_high_d_out) %>% 
  mutate(model = fct_relevel(model,c("Taxes and public goods","Equality of opportunity","Death/Double tax")),
         group = fct_relevel(group,c("Own","Not applicable/deceased","Don't own")),
         facet = fct_relevel(facettext,c("Overall level","You might pay","Your heirs might pay","<£325k","£325k-£1m",">£1m")),
         group = dplyr::recode(group, "Not applicable/deceased" = "NA/\ndeceased"))

# Plot

plot_parents_d <- plot_canvas_coefficient_experiment(df = cond) + scale_y_continuous(breaks=c(-0.2,0,0.2), lim = c(-0.35,0.35))

# Print

figure11 <- gridExtra::grid.arrange(plot_home_d, plot_parents_d, ncol=1,heights=c(8,10))

ggsave("Output/figure11.pdf",
       figure11,
       width = 550, height = 500, units = "mm")


#####################
##### Appendix ######
#####################

###
## Appendix B: Survey House Price Estimates versus ONS House Price Statistics ----
###

### Table B1: Comparing house price estimates from the YouGov survey to those from ONS ----

b0 <- df.wide %>% 
  group_by(region_name) %>% 
  filter(est_house_price>0) %>% 
  filter(est_house_price<2000000) %>%
  summarize(median_local_est = median(est_house_price, na.rm=T))

### Figure B1: Histogram of estimated house prices ----

b1 <- df.wide %>%
  ggplot(aes(x=est_house_price)) +
  geom_histogram(stat="density")+
  scale_x_log10(labels=label_comma())+
  labs(x="Estimated House Prices", y="")+
  theme_classic()

ggsave("Output/Appendix/figureB1.pdf",
       width = 150, height = 150, units = "mm")

### Figure B2: Histogram of estimated house prices, by Region ----

b2 <- df.wide %>%
  ggplot(aes(x=est_house_price)) +
  geom_histogram(stat="density")+
  scale_x_log10(labels=label_comma())+
  labs(x="Estimated House Prices", y="")+
  theme_classic()+
  facet_wrap(~region_name)

ggsave("Output/Appendix/figureB2.pdf",
       width = 150, height = 150, units = "mm")

### Figure B3: Association between Estimated House and Actual House Prices, Local Authority Level ----

### Figure B3 (left)
b3l <- df.wide %>% 
  filter(est_house_price>0) %>% 
  filter(est_house_price<2000000) %>% 
  ggplot(aes(x=median_price, y=est_house_price))+
  geom_point()+
  geom_abline(slope = 1, intercept = 0)+
  geom_smooth(method="lm")+
  theme_classic()+
  scale_x_continuous(labels = label_dollar(prefix = "£"))+
  scale_y_continuous(labels = label_dollar(prefix="£"))+
  labs(x="Median Price in Local Authority (2019)", y = "Estimated House Price (2021)", subtitle="Linear Fit")

ggsave("Output/Appendix/figureB3l.pdf",
       width = 150, height = 150, units = "mm")

### Figure B3 (right) 
b3r <- df.wide %>% 
  group_by(la_code) %>% 
  summarize(median_local_est = median(est_house_price, na.rm=T),
            median_price = mean(median_price),
            no_obs = n())%>% 
  filter(no_obs>6) %>% 
  ggplot(aes(x=median_price, y=median_local_est, label=no_obs))+
  geom_text()+
  geom_abline(slope = 1, intercept = 0)+
  geom_smooth(method="lm")+
  scale_x_continuous(labels = label_dollar(prefix = "£"))+
  scale_y_continuous(labels = label_dollar(prefix="£"))+
  theme_classic()+
  labs(x="Median Price in Local Authority (2019)", y="Median Estimated Price by Local Authority (2021)")

ggsave("Output/Appendix/figureB3r.pdf",
       width = 150, height = 150, units = "mm")

### Table B2: Regression Results for Figure B3 ----

# Model 1

b5 <- df.wide %>% 
  filter(est_house_price>0) %>% 
  filter(est_house_price<2000000) %>% 
  lm(data = ., est_house_price~median_price) %>% 
  summary(.)

# Model 2

b6 <- df.wide %>% 
  group_by(la_code) %>% 
  summarize(median_local_est = median(est_house_price, na.rm=T),
            median_price = mean(median_price),
            no_obs = n())%>% 
  filter(no_obs>6) %>% 
  lm(data = ., median_local_est~median_price) %>% 
  summary(.)


###
## Appendix C: Controlling for socio-economic status and internal political efficacy ----
###

## Table C1: Determinants of registering an opinion on question about overall inheritance tax rates while controlling for Social Grade and internal efficacy ----

# LMP socio
dk2_LPM_socio <- lm(inh_overall_dk ~ as.factor(house_rent_groups)+as.factor(house_rent_groups_parents2)+hh_income+age+female+degree+as.factor(profile_socialgrade_cie), 
                    data=df.wide)

## Logistic socio
dk2_logit_socio <- glm(inh_overall_dk ~ as.factor(house_rent_groups)+as.factor(house_rent_groups_parents2)+hh_income+age+female+degree+as.factor(profile_socialgrade_cie), 
                       data=df.wide, family=binomial(link="logit"))

# LPM efficacy
dk2_LPM_eff <- lm(inh_overall_dk ~ as.factor(house_rent_groups)+as.factor(house_rent_groups_parents2)+hh_income+age+female+degree+int_eff, 
                  data=df.wide)

# Logistic efficacy
dk2_logit_eff <- glm(inh_overall_dk ~ as.factor(house_rent_groups)+as.factor(house_rent_groups_parents2)+hh_income+age+female+degree+int_eff, 
                     data=df.wide, family=binomial(link="logit"))

# Table

stargazer(dk2_LPM_eff, dk2_logit_eff, dk2_LPM_socio, dk2_logit_socio,  type="latex",
          title = "Determinants of registering an opinion on question about overall inheritance tax rates",
          model.names = FALSE,
          keep.stat = c("n", "rsq"), 
          covariate.labels = c("/hspace{2mm} £100k and under",
                               "/hspace{2mm} £100k to £200k",
                               "/hspace{2mm} £200k to £300k",
                               "/hspace{2mm} £300k to £400k",
                               "/hspace{2mm} £400k to £500k",
                               "/hspace{2mm} £500k to £750k",
                               "/hspace{2mm} £750k and up",
                               "/hspace{2mm} Not applicable/deceased",
                               "/hspace{2mm} £200k and under",
                               "/hspace{2mm} £200k to £400k",
                               "/hspace{2mm} £400k to £600k",
                               "/hspace{2mm} £600k and up",
                               "/hspace{2mm} Household income",
                               "/hspace{2mm} Age",
                               "/hspace{2mm} Female",
                               "/hspace{2mm} University degree",
                               "/hspace{2mm} Internal efficacy",
                               "/hspace{2mm} B",
                               "/hspace{2mm} C1",
                               "/hspace{2mm} C2",
                               "/hspace{2mm} D",
                               "/hspace{2mm} E"),
          no.space=TRUE,
          star.char = c("*"), star.cutoffs = c(0.05)) 

### Figure C1: The Relationship between Current/Future Housing Wealth and Views that Inheritance Taxation is Too High while Controlling for Social Grade ----

### Left side
## overall level of taxes, your taxes, you heirs' taxes

inh_overall_socio <- lm(inh_overalld ~ house_rent_groups+house_rent_groups_parents2+hh_income+age+female+degree+as.factor(profile_socialgrade_cie), 
                       data=df.wide)

inh_you_pay_socio <- lm(inh_you_payd ~ house_rent_groups + house_rent_groups_parents2 + hh_income+age+female+degree+as.factor(profile_socialgrade_cie),  
                       data=df.wide)

inh_heirs_pay_socio <- lm(inh_heirs_payd ~ house_rent_groups + house_rent_groups_parents2 + hh_income+age+female+degree+as.factor(profile_socialgrade_cie),   
                         data=df.wide)

# Figure 5 - Linear

inh_overall_tidy_socio <- inh_overall_socio %>% tidy()

coef_inh_overall_socio <- getcoef(model_name = "Overall level", reg = inh_overall_tidy_socio)

inh_you_pay_tidy_socio <- inh_you_pay_socio %>% tidy()

coef_inh_you_pay_socio <- getcoef(model_name = "You pay", reg = inh_you_pay_tidy_socio)

inh_heirs_pay_tidy_socio <- inh_heirs_pay_socio %>% tidy()

coef_inh_heirs_pay_socio <- getcoef(model_name = "Heirs pay", reg = inh_heirs_pay_tidy_socio)

# Coef combined

coefcombined_figure5_socio <- rbind(coef_inh_overall_socio,coef_inh_you_pay_socio,coef_inh_heirs_pay_socio) %>%
  mutate(group = factor(group, levels = c("Overall level","You pay","Heirs pay")))

socio_left <- plot_canvas_coefficient(df = coefcombined_figure5_socio,
                                     face = coefcombined_figure5_socio$bold,
                                     x = reorder(coefcombined_figure5_socio$model, desc(coefcombined_figure5_socio$model)),
                                     models = reorder(coefcombined_figure5_socio$group, desc(coefcombined_figure5_socio$group)),
                                     cols = threecolours) + ylim(-0.2,0.4)

### Right side
## Low level of taxes, medium taxes, high' taxes

inh_low_socio <- lm(inh_lowd ~ house_rent_groups + house_rent_groups_parents2 +hh_income+age+female+degree+as.factor(profile_socialgrade_cie), 
                   data=df.wide)

inh_moderate_socio <- lm(inh_moderated ~ house_rent_groups+house_rent_groups_parents2+hh_income+age+female+degree+as.factor(profile_socialgrade_cie),  
                        data=df.wide)

inh_high_socio <- lm(inh_highd ~ house_rent_groups + house_rent_groups_parents2 +hh_income+age+female+degree+as.factor(profile_socialgrade_cie),   
                    data=df.wide)

# Figure 6 - Linear

inh_low_tidy_socio <- inh_low_socio %>% tidy()

coef_inh_low_socio <- getcoef(model_name = "Inheritance <£325k", reg = inh_low_tidy_socio)

inh_moderate_tidy_socio <- inh_moderate_socio %>% tidy()

coef_inh_moderate_socio <- getcoef(model_name = "Inheritance £325k-£1m", reg = inh_moderate_tidy_socio)

inh_high_tidy_socio <- inh_high_socio %>% tidy()

coef_inh_high_socio <- getcoef(model_name = "Inheritance >£1m", reg = inh_high_tidy_socio)

# Coef combined

coefcombined_figure6_socio <- rbind(coef_inh_low_socio,coef_inh_moderate_socio,coef_inh_high_socio) %>%
  mutate(group = factor(group, levels = c("Inheritance <£325k","Inheritance £325k-£1m","Inheritance >£1m")))

socio_right <- plot_canvas_coefficient(df = coefcombined_figure6_socio,
                                      face = coefcombined_figure6_socio$bold,
                                      x = reorder(coefcombined_figure6_socio$model, desc(coefcombined_figure6_socio$model)),
                                      models = reorder(coefcombined_figure6_socio$group, desc(coefcombined_figure6_socio$group)),
                                      cols = threecolours)

figurec1 <- gridExtra::grid.arrange(socio_left, socio_right, ncol=2)

ggsave("Output/Appendix/figureC1.pdf",
       figurec1,
       width = 800, height = 600, units = "mm")


###
## Appendix D: Wealth Gradient in DK-Responses for All Inheritance Tax Questions ----
###

### Figure D1: The relationship between wealth and registering an opinion on questions about inheritance taxation ----

dk37_1_linear <- glm(inh_overall_dk ~ as.factor(house_rent_groups)+as.factor(house_rent_groups_parents2)+hh_income+age+female+degree, 
                     data=df.wide) %>% tidy()

coef_dk37_1_linear <- getcoef(model_name = "Overall level", reg = dk37_1_linear)

dk37_5_linear <- glm(Q37_5_dk ~ as.factor(house_rent_groups)+as.factor(house_rent_groups_parents2)+hh_income+age+female+degree, 
                     data=df.wide) %>% tidy()

coef_dk37_5_linear <- getcoef(model_name = "Taxes you might pay", reg = dk37_5_linear)

dk37_6_linear <- glm(Q37_6_dk ~ as.factor(house_rent_groups)+as.factor(house_rent_groups_parents2)+hh_income+age+female+degree, 
                     data=df.wide) %>% tidy()

coef_dk37_6_linear <- getcoef(model_name = "Tax your heirs might pay", reg = dk37_6_linear)

dk37_4_linear <- glm(Q37_4_dk ~ as.factor(house_rent_groups)+as.factor(house_rent_groups_parents2)+hh_income+age+female+degree, 
                     data=df.wide) %>% tidy()

coef_dk37_4_linear <- getcoef(model_name = "Inheritances under ??325k", reg = dk37_4_linear)

dk37_3_linear <- glm(Q37_3_dk ~ as.factor(house_rent_groups)+as.factor(house_rent_groups_parents2)+hh_income+age+female+degree, 
                     data=df.wide) %>% tidy()

coef_dk37_3_linear <- getcoef(model_name = "Inheritances ??325k-??1m", reg = dk37_3_linear)

dk37_2_linear <- glm(Q37_2_dk ~ as.factor(house_rent_groups)+as.factor(house_rent_groups_parents2)+hh_income+age+female+degree, 
                     data=df.wide) %>% tidy()

coef_dk37_2_linear <- getcoef(model_name = "Inheritances above ??1m", reg = dk37_2_linear)

# Coef combined

coefcombined <- rbind(coef_dk37_1_linear,coef_dk37_5_linear,coef_dk37_6_linear,coef_dk37_4_linear,coef_dk37_3_linear,coef_dk37_2_linear) %>%
  mutate(group = factor(group, levels = c("Overall level","Taxes you might pay","Tax your heirs might pay","Inheritances under £325k","Inheritances £325k-£1m","Inheritances above £1m")))

figdk37_1_linear <- plot_canvas_coefficient(df = coefcombined,
                                            face = coefcombined$bold,
                                            x = reorder(coefcombined$model, desc(coefcombined$model)),
                                            models = reorder(coefcombined$group, desc(coefcombined$group)),
                                            cols = c("grey","#273046","#354823","#FAD510","black","#CB2314")) + 
  ylim(-0.2,0.4)

ggsave("Output/Appendix/figureD1.pdf",
       figdk37_1_linear,
       width = 400, height = 300, units = "mm")


###
## Appendix E: Inheritance vs. Income Taxation ----
###

### Figure E1: Preferences over income taxation ----

p1a <- plot_canvas_figure1(df = df.wide, q = df.wide$Q38_1, labs = "Overall level of income tax",ylimits = c(0, .5))

p2a <- plot_canvas_figure1(df = df.wide, q = df.wide$Q38_6, labs = "Incomes above £150",ylimits = c(0, .5))

p3a <- plot_canvas_figure1(df = df.wide, q = df.wide$Q38_2, labs = "Incomes £75k-£150k",ylimits = c(0, .5))

p4a <- plot_canvas_figure1(df = df.wide, q = df.wide$Q38_3, labs = "Incomes £25,000-£75kk",ylimits = c(0, .5))

p5a <- plot_canvas_figure1(df = df.wide, q = df.wide$Q38_4, labs = "Incomes under £25k",ylimits = c(0, .5))

p6a <- plot_canvas_figure1(df = df.wide, q = df.wide$Q38_5, labs = "Income tax you pay",ylimits = c(0, .5))

# Print figure

figuree1 <- gridExtra::grid.arrange(p1a, p6a, p5a, p4a, p3a, p2a, ncol=3)

ggsave("Output/Appendix/figureE1.pdf",
       figuree1,
       width = 550, height = 275, units = "mm")

### Figure E2: Preferences over the progressivity of the inheritance and income tax systems ----

## loading wide format data containing tax triplets (coded in stata)
df.tax.triplets <- read_csv("df_data_tax_triplets.csv")

prop.table(table(df.tax.triplets$overall_inh_tax)) # Inheritance tax schedule
prop.table(table(df.tax.triplets$overall_inc_tax)) # Income tax schedule

p7 <- ggplot(data=df.tax.triplets) + 
  geom_bar(mapping = aes(x = overall_inh_tax, y = ..prop..), 
           stat = "count", width = .9, color="black", 
           size=1)+
  xlab("")+ ylab("Proportion")+ 
  labs(title="Inheritance Tax Schedule")+
  scale_x_continuous(guide = guide_axis(n.dodge = 1), 
                     labels = function(x) stringr::str_wrap(c("More progressive taxes", 
                                                              "Higher taxes",
                                                              "Status quo",
                                                              "Lower taxes",
                                                              "More regressive taxes",
                                                              "Mixed preference",
                                                              "Don't know"), width = 6),
                     breaks=c(1,2,3,4,5,6,7))+
  scale_y_continuous(limits = c(0, 0.5))+
  theme_minimal()+
  theme(axis.text=element_text(size=14),
        axis.title=element_text(size=16),
        title=element_text(size=16))

p8 <- ggplot(data=df.tax.triplets) + 
  geom_bar(mapping = aes(x = overall_inc_tax, y = ..prop..), 
           stat = "count", width = .9, color="black", 
           size=1)+
  xlab("")+ ylab("Proportion")+ 
  labs(title="Income Tax Schedule")+
  scale_x_continuous(guide = guide_axis(n.dodge = 1), 
                     labels = function(x) stringr::str_wrap(c("More progressive taxes", 
                                                              "Higher taxes",
                                                              "Status quo",
                                                              "Lower taxes",
                                                              "More regressive taxes",
                                                              "Mixed preference", 
                                                              "Don't know"), width = 6),
                     breaks=c(1,2,3,4, 5,6, 7))+
  scale_y_continuous(limits = c(0, 0.5))+
  theme_minimal()+
  theme(axis.text=element_text(size=14),
        axis.title=element_text(size=16),
        title=element_text(size=16))

p.all2 <- gridExtra::grid.arrange(p7, p8, ncol=2)

ggsave("Output/Appendix/figureE2.pdf",
       p.all2,
       width = 400, height = 200, units = "mm")

### Table E1: Probability of answering questions about overall inheritance and income tax levels, by socio-economic and wealth status ----

### Comparing income vs inheritance tax questions:
## SES and wealth group

# low SES is a person with an annual household income below £5000, woman, and no university degree
# high SES is a person with an annual household income above £150k, man, and university degree
# low wealth is a renter whose parents don't own a house
# high wealth is a homeowner with a house worth more than £750 and whose parents own a house worth more than £600k

# low_low: low SES, low wealth
# high_high: high SES, high wealth
# low_high: low SES, high wealth
# high_low: high SES, low wealth
group <- c("low_low", "low_high", "high_low", "high_high")

# Inheritance
dk2 <- glm(inh_overall_dk ~ as.factor(house_rent_groups)+as.factor(house_rent_groups_parents2)+hh_income+age+female+degree, 
                 data=df.wide, family=binomial(link="logit"))

xb.low.low.inh <- dk2$coef[1] + dk2$coef[2]*0 +dk2$coef[3]*0 + dk2$coef[4]*0 + dk2$coef[5]*0 + dk2$coef[6]*0 + dk2$coef[7]*0 + dk2$coef[8]*0 + dk2$coef[9]*0 + dk2$coef[10]*0 + dk2$coef[11]*0 + dk2$coef[12]*0 + dk2$coef[13]*0 + dk2$coef[14]*1  + dk2$coef[15]*mean(df.wide$age) + dk2$coef[16]*1 + dk2$coef[17]*0
xb.low.high.inh <- dk2$coef[1] + dk2$coef[2]*0 +dk2$coef[3]*0 + dk2$coef[4]*0 + dk2$coef[5]*0 + dk2$coef[6]*0 + dk2$coef[7]*0 + dk2$coef[8]*1 + dk2$coef[9]*0 + dk2$coef[10]*0 + dk2$coef[11]*0 + dk2$coef[12]*0 + dk2$coef[13]*1 + dk2$coef[14]*1  + dk2$coef[15]*mean(df.wide$age) + dk2$coef[16]*1 + dk2$coef[17]*0

xb.high.low.inh <- dk2$coef[1] + dk2$coef[2]*0 +dk2$coef[3]*0 + dk2$coef[4]*0 + dk2$coef[5]*0 + dk2$coef[6]*0 + dk2$coef[7]*0 + dk2$coef[8]*0 + dk2$coef[9]*0 + dk2$coef[10]*0 + dk2$coef[11]*0 + dk2$coef[12]*0 + dk2$coef[13]*0 + dk2$coef[14]*15  + dk2$coef[15]*mean(df.wide$age) + dk2$coef[16]*0 + dk2$coef[17]*1
xb.high.high.inh <- dk2$coef[1] + dk2$coef[2]*0 +dk2$coef[3]*0 + dk2$coef[4]*0 + dk2$coef[5]*0 + dk2$coef[6]*0 + dk2$coef[7]*0 + dk2$coef[8]*1 + dk2$coef[9]*0 + dk2$coef[10]*0 + dk2$coef[11]*0 + dk2$coef[12]*0 + dk2$coef[13]*1 + dk2$coef[14]*15  + dk2$coef[15]*mean(df.wide$age) + dk2$coef[16]*0 + dk2$coef[17]*1

xb.low.low.inh.pred <- invlogit(xb.low.low.inh)
xb.low.high.inh.pred <- invlogit(xb.low.high.inh)
xb.high.low.inh.pred <- invlogit(xb.high.low.inh)
xb.high.high.inh.pred <- invlogit(xb.high.high.inh)

pp.inh <- c(xb.low.low.inh.pred,xb.low.high.inh.pred, xb.high.low.inh.pred, xb.high.high.inh.pred )

df.pp.inh <- data.frame(group, pp.inh)

# Income
dk.income <- glm(inc_overall_dk ~ as.factor(house_rent_groups)+as.factor(house_rent_groups_parents2)+hh_income+age+female+degree, 
                 data=df.wide, family=binomial(link="logit"))

xb.low.low.inc <- dk.income$coef[1] + dk.income$coef[2]*0 +dk.income$coef[3]*0 + dk.income$coef[4]*0 + dk.income$coef[5]*0 + dk.income$coef[6]*0 + dk.income$coef[7]*0 + dk.income$coef[8]*0 + dk.income$coef[9]*0 + dk.income$coef[10]*0 + dk.income$coef[11]*0 + dk.income$coef[12]*0 + dk.income$coef[13]*0 + dk.income$coef[14]*1  + dk.income$coef[15]*mean(df.wide$age) + dk.income$coef[16]*1 + dk.income$coef[17]*0
xb.low.high.inc <- dk.income$coef[1] + dk.income$coef[2]*0 +dk.income$coef[3]*0 + dk.income$coef[4]*0 + dk.income$coef[5]*0 + dk.income$coef[6]*0 + dk.income$coef[7]*0 + dk.income$coef[8]*1 + dk.income$coef[9]*0 + dk.income$coef[10]*0 + dk.income$coef[11]*0 + dk.income$coef[12]*0 + dk.income$coef[13]*1 + dk.income$coef[14]*1  + dk.income$coef[15]*mean(df.wide$age) + dk.income$coef[16]*1 + dk.income$coef[17]*0

xb.high.low.inc <- dk.income$coef[1] + dk.income$coef[2]*0 +dk.income$coef[3]*0 + dk.income$coef[4]*0 + dk.income$coef[5]*0 + dk.income$coef[6]*0 + dk.income$coef[7]*0 + dk.income$coef[8]*0 + dk.income$coef[9]*0 + dk.income$coef[10]*0 + dk.income$coef[11]*0 + dk.income$coef[12]*0 + dk.income$coef[13]*0 + dk.income$coef[14]*15  + dk.income$coef[15]*mean(df.wide$age) + dk.income$coef[16]*0 + dk.income$coef[17]*1
xb.high.high.inc <- dk.income$coef[1] + dk.income$coef[2]*0 +dk.income$coef[3]*0 + dk.income$coef[4]*0 + dk.income$coef[5]*0 + dk.income$coef[6]*0 + dk.income$coef[7]*0 + dk.income$coef[8]*1 + dk.income$coef[9]*0 + dk.income$coef[10]*0 + dk.income$coef[11]*0 + dk.income$coef[12]*0 + dk.income$coef[13]*1 + dk.income$coef[14]*15  + dk.income$coef[15]*mean(df.wide$age) + dk.income$coef[16]*0 + dk.income$coef[17]*1

xb.low.low.inc.pred <- invlogit(xb.low.low.inc)
xb.low.high.inc.pred <- invlogit(xb.low.high.inc)
xb.high.low.inc.pred <- invlogit(xb.high.low.inc)
xb.high.high.inc.pred <- invlogit(xb.high.high.inc)

pp.inc <- c(xb.low.low.inc.pred,xb.low.high.inc.pred, xb.high.low.inc.pred, xb.high.high.inc.pred )

df.pp.inc <- data.frame(group, pp.inc)


###
## Appendix F: Full Set of Results for Figure 4 ----
###

### Table F1: Table for Figure 4 ----

inh_overall_fig4 <- lm(inh_overalld ~ house_rent_groups + house_rent_groups_parents2+ hh_income+age+female+degree, 
                       data=df.wide)

inh_you_pay_fig4 <- lm(inh_you_payd ~ house_rent_groups + house_rent_groups_parents2 + hh_income+age+female+degree,  
                       data=df.wide)

inh_heirs_pay_fig4 <- lm(inh_heirs_payd ~ house_rent_groups + house_rent_groups_parents2 + hh_income+age+female+degree,   
                         data=df.wide)
inh_low_fig4 <- lm(inh_lowd ~ house_rent_groups + house_rent_groups_parents2 + hh_income+age+female+degree, 
                   data=df.wide)

inh_moderate_fig4 <- lm(inh_moderated ~ house_rent_groups + house_rent_groups_parents2 + hh_income+age+female+degree,  
                        data=df.wide)

inh_high_fig4 <- lm(inh_highd ~ house_rent_groups + house_rent_groups_parents2 + hh_income+age+female+degree,   
                    data=df.wide)

stargazer(inh_overall_fig4, inh_you_pay_fig4, inh_heirs_pay_fig4, inh_low_fig4, inh_moderate_fig4, inh_high_fig4,
          title = "",
          dep.var.labels = c("Overall level", "You pay", "Heirs pay", "<£325k", "£325k-£1m", ">£1m"),
          model.names = FALSE,
          covariate.labels = c("hspace{2mm} £100k and under", 
                               "hspace{2mm} £100k to £200k", 
                               "hspace{2mm} £200k to £300k",
                               "hspace{2mm} £300k to £400k",
                               "hspace{2mm} £400k to £500k",  
                               "hspace{2mm} £500k to £750k", 
                               "hspace{2mm} £750k and up",
                               "hspace{2mm} Not applicable/deceased",
                               "hspace{2mm} £200k and under",
                               "hspace{2mm} £200k to £400k",
                               "hspace{2mm} £400k to £600k",
                               "hspace{2mm} £600k and up",
                               "hspace{2mm} Household income",
                               "hspace{2mm} Age",
                               "hspace{2mm} Female",
                               "hspace{2mm} University degree"
          ),
          no.space=TRUE,
          keep.stat = c("n"), 
          star.char = c("*"), star.cutoffs = c(0.05)) 


###
## Appendix G: Information Experiment I: House Price Distributions ----
###

### Table G1: Balance Tests, Information Experiment ----

covs <- subset(df.wide, select = c(age,female,hh_income,homeowner,degree,parent_homeowner,house_rent_groups,house_rent_groups_parents2))
bal.tab(covs, treat = df.wide$Qtreatment, thresholds = c(m = .1))

### Figure G2: Treatment effects on preferred inheritance tax rates ----

mm_diff_by_treatment <- cj(df.conjoint, chose_plan_inh ~ factor_inheritance_gr1 + factor_inheritance_gr2 + factor_inheritance_gr3 + factor_inheritance_gr4, id = ~id, estimate = "mm_diff", by = ~factor_qtreatment)
treatment_mm_diff <- plot(mm_diff_by_treatment, group = "factor_qtreatment", vline = 0)+
  scale_colour_manual(limits = c("National", "National+local", ""),
                      values = c("black", "gray", "white"))+
  guides(color = guide_legend(title="Treatment:", nrow = 1, label.hjust=-10))+
  ggplot2::scale_x_continuous(
    limits = c(-0.06, 0.06), 
    breaks = c(-0.06, -0.03, 0, 0.03, 0.06))+
  theme(axis.text=element_text(size=12),
        axis.title = element_text(size = 12),
        legend.title=element_text(size=12),
        legend.text=element_text(size=12),
        legend.position="bottom")

ggsave("Output/Appendix/figureG2.pdf",
       treatment_mm_diff,
       width = 135, height = 175, units = "mm")

### Table G2: People Are Not More Likely to Register an Opinion when Getting the Information Treatment ----

inh_overall_dk_linear <- lm_robust(inh_overall_dk ~ factor(Qtreatment), data = df.wide)
inh_you_dk_linear <- lm_robust(Q37_5_dk ~ factor(Qtreatment), data = df.wide)
inh_heirs_dk_linear <- lm_robust(Q37_6_dk ~ factor(Qtreatment), data = df.wide)
inh_low_dk_linear <- lm_robust(Q37_4_dk ~ factor(Qtreatment), data = df.wide)
inh_mid_dk_linear <- lm_robust(Q37_3_dk ~ factor(Qtreatment), data = df.wide)
inh_high_dk_linear <- lm_robust(Q37_2_dk ~ factor(Qtreatment), data = df.wide)

# Regression table

texreg(list(inh_overall_dk_linear,
            inh_you_dk_linear,
            inh_heirs_dk_linear,
            inh_low_dk_linear,
            inh_mid_dk_linear,
            inh_high_dk_linear),
       stars = 0.05,
       custom.model.names = c("Overall level", "You might pay", "Your heirs might pay", "$<$£325k",
                              "£325k-£1m", "$>$£1m"),
       custom.coef.names = c("Constant",
                             "National treatment", 
                             "National+local treatment"
       ),
       caption = "People Are Not More Likely to Register an Opinion when Getting the Information Treatment",
       caption.above = TRUE,
       include.nobs = TRUE,
       include.rsquared = TRUE,
       include.adjrs = FALSE,
       include.rmse = FALSE,
       include.ci = FALSE,
       custom.note = "%stars. Linear probability model. Dependent variable equal 1 if respondent registered a preference, 0 otherwise."
)

### Figure G3: The information treatment had no effect on inheritance tax preferences even for respondents who answered our comprehension check questions correctly. ----

inh_o <- lm(inh_overalld ~ as.factor(treatment_cc), 
            data=df.wide)
inh_y <- lm(inh_you_payd ~ as.factor(treatment_cc), 
            data=df.wide)
inh_h <- lm(inh_heirs_payd ~ as.factor(treatment_cc), 
            data=df.wide)
inh_low <- lm(inh_lowd ~ as.factor(treatment_cc), 
              data=df.wide)
inh_moderate <- lm(inh_moderated ~ as.factor(treatment_cc), 
                   data=df.wide)
inh_high <- lm(inh_highd ~ as.factor(treatment_cc), 
               data=df.wide)

inh_o_tidy <- inh_o %>% tidy()
inh_y_tidy <- inh_y %>% tidy()
inh_h_tidy <- inh_h %>% tidy()
inh_low_tidy <- inh_low %>% tidy()
inh_moderate_tidy <- inh_moderate %>% tidy()
inh_high_tidy <- inh_high %>% tidy()

# Create tibble

tibblefigurec3 <- tibble(model = c(rep("Overall level",2),rep("You might pay",2),
                                   rep("Your heirs might pay",2),rep("<325k",2),
                                   rep("325-1m",2),rep(">1m",2)),
                         group= c(rep(c("National","National + Local"),6)),
                         estimate = c(inh_o_tidy$estimate[2],inh_o_tidy$estimate[3],
                                      inh_y_tidy$estimate[2],inh_y_tidy$estimate[3],
                                      inh_h_tidy$estimate[2],inh_h_tidy$estimate[3],
                                      inh_low_tidy$estimate[2],inh_low_tidy$estimate[3],
                                      inh_moderate_tidy$estimate[2],inh_moderate_tidy$estimate[3],
                                      inh_high_tidy$estimate[2],inh_high_tidy$estimate[3]),
                         stderror = c(inh_o_tidy$std.error[2],inh_o_tidy$std.error[3],
                                      inh_y_tidy$std.error[2],inh_y_tidy$std.error[3],
                                      inh_h_tidy$std.error[2],inh_h_tidy$std.error[3],
                                      inh_low_tidy$std.error[2],inh_low_tidy$std.error[3],
                                      inh_moderate_tidy$std.error[2],inh_moderate_tidy$std.error[3],
                                      inh_high_tidy$std.error[2],inh_high_tidy$std.error[3]),
                         bold = c(rep("plain",12))) %>% 
  mutate(model = factor(model, levels = c("Overall level",
                                          "You might pay",
                                          "Your heirs might pay",
                                          "<325k",
                                          "325-1m",
                                          ">1m")))

tibblefigurec3$bold <- rep("plain",nrow(tibblefigurec3))

figureg3 <- plot_canvas_coefficient(df = tibblefigurec3,
                                 x = reorder(tibblefigurec3$model, desc(tibblefigurec3$model)),
                                 models = reorder(tibblefigurec3$group, desc(tibblefigurec3$group)),
                                 cols = twocolours) + 
  ylim(-0.2,0.2)

ggsave("Output/Appendix/figureG3.pdf",
       figureg3,
       width = 250, height = 200, units = "mm")

### Table G3: Omnibus tests of differential treatment effects by own and parents' housing tenure ----

df.conjoint <- df.conjoint %>% 
  mutate(hh_income_3 = case_when(hh_income %in% 1:4 ~ 1,
                                 hh_income %in% 5:9 ~ 2,
                                 hh_income > 10 ~ 3))

df.conjoint$factor_hh_income_3 <- factor(df.conjoint$hh_income_3,
                                         levels = c(1,2,3),
                                         labels = c("Low", "Middle", "High"))

m.homeowner1 <- lm(chose_plan_inh ~  
                     factor_inheritance_gr1*factor_homeowner + 
                     factor_inheritance_gr2*factor_homeowner + 
                     factor_inheritance_gr3*factor_homeowner + 
                     factor_inheritance_gr4*factor_homeowner, data=df.conjoint)

m.homeowner2 <- lm(chose_plan_inh ~  
                     factor_inheritance_gr1*factor_homeowner*factor_qtreatment + 
                     factor_inheritance_gr2*factor_homeowner*factor_qtreatment + 
                     factor_inheritance_gr3*factor_homeowner*factor_qtreatment + 
                     factor_inheritance_gr4*factor_homeowner*factor_qtreatment, data=df.conjoint)

m.parent.homeowner1 <- lm(chose_plan_inh ~  
                            factor_inheritance_gr1*factor_parent_homeowner + 
                            factor_inheritance_gr2*factor_parent_homeowner + 
                            factor_inheritance_gr3*factor_parent_homeowner + 
                            factor_inheritance_gr4*factor_parent_homeowner, data=df.conjoint)

m.parent.homeowner2 <- lm(chose_plan_inh ~  
                            factor_inheritance_gr1*factor_parent_homeowner*factor_qtreatment + 
                            factor_inheritance_gr2*factor_parent_homeowner*factor_qtreatment + 
                            factor_inheritance_gr3*factor_parent_homeowner*factor_qtreatment + 
                            factor_inheritance_gr4*factor_parent_homeowner*factor_qtreatment, data=df.conjoint)


m.value.house1 <- lm(chose_plan_inh ~  
                       factor_inheritance_gr1*factor_house_price_group + 
                       factor_inheritance_gr2*factor_house_price_group + 
                       factor_inheritance_gr3*factor_house_price_group + 
                       factor_inheritance_gr4*factor_house_price_group, data=df.conjoint)

m.value.house2 <- lm(chose_plan_inh ~  
                       factor_inheritance_gr1*factor_house_price_group*factor_qtreatment + 
                       factor_inheritance_gr2*factor_house_price_group*factor_qtreatment + 
                       factor_inheritance_gr3*factor_house_price_group*factor_qtreatment + 
                       factor_inheritance_gr4*factor_house_price_group*factor_qtreatment, data=df.conjoint)


m.value.parents.house1 <- lm(chose_plan_inh ~  
                               factor_inheritance_gr1*factor_house_price_group_parents + 
                               factor_inheritance_gr2*factor_house_price_group_parents + 
                               factor_inheritance_gr3*factor_house_price_group_parents + 
                               factor_inheritance_gr4*factor_house_price_group_parents, data=df.conjoint)

m.value.parents.house2 <- lm(chose_plan_inh ~  
                               factor_inheritance_gr1*factor_house_price_group_parents*factor_qtreatment + 
                               factor_inheritance_gr2*factor_house_price_group_parents*factor_qtreatment + 
                               factor_inheritance_gr3*factor_house_price_group_parents*factor_qtreatment + 
                               factor_inheritance_gr4*factor_house_price_group_parents*factor_qtreatment, data=df.conjoint)


m.income1 <- lm(chose_plan_inh ~ 
                  factor_inheritance_gr1*factor_hh_income_3 + 
                  factor_inheritance_gr2*factor_hh_income_3 + 
                  factor_inheritance_gr3*factor_hh_income_3 + 
                  factor_inheritance_gr4*factor_hh_income_3, data=df.conjoint)

m.income2 <- lm(chose_plan_inh ~  
                  factor_inheritance_gr1*factor_hh_income_3*factor_qtreatment + 
                  factor_inheritance_gr2*factor_hh_income_3*factor_qtreatment + 
                  factor_inheritance_gr3*factor_hh_income_3*factor_qtreatment + 
                  factor_inheritance_gr4*factor_hh_income_3*factor_qtreatment, data=df.conjoint)


m.degree1 <- lm(chose_plan_inh ~ 
                  factor_inheritance_gr1*degree + 
                  factor_inheritance_gr2*degree + 
                  factor_inheritance_gr3*degree + 
                  factor_inheritance_gr4*degree, data=df.conjoint)

m.degree2 <- lm(chose_plan_inh ~  
                  factor_inheritance_gr1*degree*factor_qtreatment + 
                  factor_inheritance_gr2*degree*factor_qtreatment + 
                  factor_inheritance_gr3*degree*factor_qtreatment + 
                  factor_inheritance_gr4*degree*factor_qtreatment, data=df.conjoint)


m.gender1 <- lm(chose_plan_inh ~ 
                  factor_inheritance_gr1*gender + 
                  factor_inheritance_gr2*gender + 
                  factor_inheritance_gr3*gender + 
                  factor_inheritance_gr4*gender, data=df.conjoint)

m.gender2 <- lm(chose_plan_inh ~  
                  factor_inheritance_gr1*gender*factor_qtreatment + 
                  factor_inheritance_gr2*gender*factor_qtreatment + 
                  factor_inheritance_gr3*gender*factor_qtreatment + 
                  factor_inheritance_gr4*gender*factor_qtreatment, data=df.conjoint)


anova(m.homeowner1, m.homeowner2, test='F')
anova(m.parent.homeowner1, m.parent.homeowner2, test='F')
anova(m.value.house1, m.value.house2, test='F')
anova(m.value.parents.house1, m.value.parents.house2, test='F')
anova(m.income1, m.income2, test='F')
anova(m.degree1, m.degree2, test='F')
anova(m.gender1, m.gender2, test='F')

### Table G4: Table for Figure 8 ---- 

inh_o <- lm(inh_overalld ~ as.factor(Qtreatment), data=df.wide)
inh_y <- lm(inh_you_payd ~ as.factor(Qtreatment), data=df.wide)
inh_h <- lm(inh_heirs_payd ~ as.factor(Qtreatment), data=df.wide)
inh_low <- lm(inh_lowd ~ as.factor(Qtreatment), data=df.wide)
inh_moderate <- lm(inh_moderated ~ as.factor(Qtreatment), data=df.wide)
inh_high <- lm(inh_highd ~ as.factor(Qtreatment), data=df.wide)

stargazer(inh_o, inh_y, inh_h, inh_low, inh_moderate, inh_high,   type="latex",
          title = "",
          dep.var.labels = c("Overall level", "You might pay", "Your heirs might pay", "<£325k", "£325k-£1m", ">£1m"),
          model.names = FALSE,
          covariate.labels = c("/hspace{2mm} National", 
                               "/hspace{2mm} National+local"),
          no.space=TRUE,
          keep.stat = c("n"), 
          star.char = c("*"), star.cutoffs = c(0.05)) 

# Pooled regression

comb_overall <- df.wide %>% dplyr::select(tax = inh_overalld, Qtreatment, house_rent_2groups, house_rent_3groups_parents, ID) %>% 
  mutate(group = "inh_overall_d")

comb_you <- df.wide %>% dplyr::select(tax = inh_you_payd, Qtreatment, house_rent_2groups, house_rent_3groups_parents, ID) %>% 
  mutate(group = "inh_you_payd")

comb_heirs <- df.wide %>% dplyr::select(tax = inh_heirs_payd, Qtreatment, house_rent_2groups, house_rent_3groups_parents, ID) %>% 
  mutate(group = "inh_heirs_payd")

comb_low <- df.wide %>% dplyr::select(tax = inh_lowd, Qtreatment, house_rent_2groups, house_rent_3groups_parents, ID) %>% 
  mutate(group = "inh_lowd")

comb_mid <- df.wide %>% dplyr::select(tax = inh_moderated, Qtreatment, house_rent_2groups, house_rent_3groups_parents, ID) %>% 
  mutate(group = "inh_moderated")

comb_high <- df.wide %>% dplyr::select(tax = inh_highd, Qtreatment, house_rent_2groups, house_rent_3groups_parents, ID) %>% 
  mutate(group = "inh_highd")

comb_all_exp1 <- bind_rows(comb_overall,comb_you,comb_heirs,comb_low,comb_mid,comb_high)

lm_direct <- lm_robust(tax ~ as.factor(Qtreatment), data=comb_all_exp1, clusters = ID)

texreg(lm_direct,  type="latex",
       caption = "",
       custom.model.names = c("Pooled analysis"),
       custom.coef.names = c("Constant",
                             "/hspace{2mm} National", 
                             "/hspace{2mm} National+local"),
       no.space=TRUE,
       caption.above = TRUE,
       include.nobs = TRUE,
       include.rsquared = TRUE,
       include.adjrs = FALSE,
       include.rmse = FALSE,
       include.ci = FALSE,
       digits = 3,
       stars = c(0.05)) 


### Table G5: Table for Top Panel of Figure 9 ----

inh_o_d <- lm(inh_overalld ~ as.factor(Qtreatment)*homeowner, data=df.wide)
inh_y_d <- lm(inh_you_payd ~ as.factor(Qtreatment)*homeowner,data=df.wide)
inh_h_d <- lm(inh_heirs_payd ~ as.factor(Qtreatment)*homeowner,data=df.wide)
inh_low_d <- lm(inh_lowd ~ as.factor(Qtreatment)*homeowner,data=df.wide)
inh_moderate_d <- lm(inh_moderated ~ as.factor(Qtreatment)*homeowner,data=df.wide)
inh_high_d <- lm(inh_highd ~ as.factor(Qtreatment)*homeowner,data=df.wide)

## regression table: 
texreg(list(inh_o_d, 
            inh_y_d,
            inh_h_d,
            inh_low_d,
            inh_moderate_d,
            inh_high_d),
       stars = 0.05,
       digits = 3,
       custom.model.names = c("Overall level", "You might pay", "Your heirs might pay", "£325k",
                              "£325k-£1m", ">£1m"),
       custom.coef.names = c("Constant",
                             "National treatment", 
                             "National+local treatment", 
                             "Homeowner",
                             "National X homeowner",
                             "National+local X homeowner"),
       caption = "Table for Figure \ref{fig:cond_d3}",
       caption.above = TRUE,
       include.nobs = TRUE,
       include.rsquared = TRUE,
       include.adjrs = FALSE,
       include.rmse = FALSE,
       include.ci = FALSE,
       custom.note = "%stars. Linear probability model. Dependent variable is whether the respondent thinks that taxes are (much) too high"
)

# Pooled regression

lm_ownhouse <- lm_robust(tax ~ as.factor(Qtreatment)*house_rent_2groups, data=comb_all_exp1, clusters = ID)

texreg(lm_ownhouse,  type="latex",
       caption = "",
       custom.model.names = c("Pooled analysis"),
       custom.coef.names = c("Constant",
                             "/hspace{2mm} National treatment", 
                             "/hspace{2mm} National+local treatment",
                             "/hspace{2mm} Homeowner",
                             "/hspace{2mm} National x Homeowner",
                             "/hspace{2mm} National+local x Homeowner"),
       no.space=TRUE,
       caption.above = TRUE,
       include.nobs = TRUE,
       include.rsquared = TRUE,
       include.adjrs = FALSE,
       include.rmse = FALSE,
       include.ci = FALSE,
       digits = 3,
       stars = c(0.05)) 

### Table G6: Table for Bottom Panel of Figure 9 ----

inh_o_d <- lm(inh_overalld ~ as.factor(Qtreatment)*house_rent_3groups_parents, data=df.wide)
inh_y_d <- lm(inh_you_payd ~ as.factor(Qtreatment)*house_rent_3groups_parents,data=df.wide)
inh_h_d <- lm(inh_heirs_payd ~ as.factor(Qtreatment)*house_rent_3groups_parents,data=df.wide)
inh_low_d <- lm(inh_lowd ~ as.factor(Qtreatment)*house_rent_3groups_parents,data=df.wide)
inh_moderate_d <- lm(inh_moderated ~ as.factor(Qtreatment)*house_rent_3groups_parents,data=df.wide)
inh_high_d <- lm(inh_highd ~ as.factor(Qtreatment)*house_rent_3groups_parents,data=df.wide)

# regression table
texreg(list(inh_o_d, 
            inh_y_d,
            inh_h_d,
            inh_low_d,
            inh_moderate_d,
            inh_high_d),
       stars = 0.05,
       digits = 3,
       custom.model.names = c("Overall level", "You might pay", "Your heirs might pay", "£325k",
                              "£325k-£1m", ">£1m"),
       custom.coef.names = c("Constant",
                             "National treatment", 
                             "National+local treatment", 
                             "NA/deceased",
                             "Homeowner",
                             "National X NA/deceased",
                             "National+local X NA/deceased",
                             "National X homeowner",
                             "National+local X homeowner"),
       caption = "Table for Figure \ref{fig:cond_d3}",
       caption.above = TRUE,
       include.nobs = TRUE,
       include.rsquared = TRUE,
       include.adjrs = FALSE,
       include.rmse = FALSE,
       include.ci = FALSE,
       custom.note = "%stars. Linear probability model. Dependent variable is whether the respondent thinks that taxes are (much) too high"
)

# Pooled regression

lm_parents <- lm_robust(tax ~ as.factor(Qtreatment)*house_rent_3groups_parents, data=comb_all_exp1, clusters = ID)

texreg(lm_parents,  type="latex",
       caption = "",
       custom.model.names = c("Pooled analysis"),
       custom.coef.names = c("Constant",
                             "/hspace{2mm} National treatment", 
                             "/hspace{2mm} National+local treatment",
                             "/hspace{2mm} NA/deceased",
                             "/hspace{2mm} Homeowner",
                             "/hspace{2mm} National x National X NA/deceased",
                             "/hspace{2mm} National+local X NA/deceased",
                             "/hspace{2mm} National x Homeowner",
                             "/hspace{2mm} National+local x Homeowner"),
       no.space=TRUE,
       caption.above = TRUE,
       include.nobs = TRUE,
       include.rsquared = TRUE,
       include.adjrs = FALSE,
       include.rmse = FALSE,
       include.ci = FALSE,
       digits = 3,
       stars = c(0.05))

### Table G7: Determinants of thinking that inheritance taxes are (much) too high ----

overall_LPM <- lm(inh_overalld ~ as.factor(house_rent_groups) + as.factor(house_rent_groups_parents2) + hh_income + age + female + degree + party_ID +
                    as.factor(Qtreatment), 
                  data=df.wide)

you_LPM <- lm(inh_you_payd ~ as.factor(house_rent_groups) + as.factor(house_rent_groups_parents2) + hh_income + age + female + degree + party_ID +
                as.factor(Qtreatment), 
              data=df.wide)

heirs_LPM <- lm(inh_heirs_payd ~ as.factor(house_rent_groups) + as.factor(house_rent_groups_parents2) + hh_income + age + female + degree + party_ID +
                  as.factor(Qtreatment), 
                data=df.wide)

low_LPM <- lm(inh_lowd ~ as.factor(house_rent_groups) + as.factor(house_rent_groups_parents2) + hh_income + age + female + degree + party_ID +
                as.factor(Qtreatment), 
              data=df.wide)

mid_LPM <- lm(inh_moderated ~ as.factor(house_rent_groups) + as.factor(house_rent_groups_parents2) + hh_income + age + female + degree + party_ID +
                as.factor(Qtreatment), 
              data=df.wide)

high_LPM <- lm(inh_highd ~ as.factor(house_rent_groups) + as.factor(house_rent_groups_parents2) + hh_income + age + female + degree + party_ID +
                 as.factor(Qtreatment), 
               data=df.wide)

stargazer(overall_LPM, you_LPM, heirs_LPM, low_LPM, mid_LPM, high_LPM,  type="latex",
          title = "Determinants of thinking that The Overall Level of Inheritance Taxes are (much) too high",
          dep.var.labels = c("Overall level", "You pay", "Heirs pay", "Overall level", "You pay", "Heirs pay"),
          model.names = FALSE,
          keep.stat = c("n", "rsq"), 
          covariate.labels = c("/hspace{2mm} £100k and under",
                               "/hspace{2mm} £100k to £200k",
                               "/hspace{2mm} £200k to £300k",
                               "/hspace{2mm} £300k to £400k",
                               "/hspace{2mm} £400k to £500k",
                               "/hspace{2mm} £500k to £750k",
                               "/hspace{2mm} £750k and up",
                               "/hspace{2mm} Not applicable/deceased",
                               "/hspace{2mm} £200k and under",
                               "/hspace{2mm} £200k to £400k",
                               "/hspace{2mm} £400k to £600k",
                               "/hspace{2mm} £600k and up",
                               "/hspace{2mm} Household income",
                               "/hspace{2mm} Age",
                               "/hspace{2mm} Female",
                               "/hspace{2mm} University degree",
                               "/hspace{2mm} Labour",
                               "/hspace{2mm} Other/Don't know",
                               "/hspace{2mm} National treatment",
                               "/hspace{2mm} National+local treatment"),
          no.space=TRUE,
          #     order = c(2:20,1),
          star.char = c("*"), star.cutoffs = c(0.05))

### Figure G4: Misperception of house value, by quintiles ----

# House price percentile thresholds: 
# 20th: 132000
# 40th: 195000
# 60th: 273000
# 80th: 400000

df.wide <- df.wide %>%
  mutate(quintile_val_hou = case_when(est_house_price <= 132000 ~ 1,
                                      between(est_house_price, 132001, 195000) ~ 2,
                                      between(est_house_price, 195001, 273000) ~ 3,
                                      between(est_house_price, 273001, 400000) ~ 4,
                                      est_house_price > 400000 ~ 5,
                                      TRUE ~ NA_real_))

my.table <- as.data.frame(table(df.wide$quintile_val_hou,df.wide$perception_val_hou))
colnames(my.table)<-c("actual","perceived","freq")
my.table

heatmap <- ggplot(my.table, aes(actual,perceived)) + 
  geom_tile(aes(fill = freq), colour = "black") +
  scale_fill_gradient(low = "white", high = "navy") + 
  labs(x="Estimated house value quintile", y="Perceived quintile", fill="") +
  theme(axis.text=element_text(size=16),
        axis.title=element_text(size=16),
        axis.text.x=element_text(colour="black"),
        axis.text.y=element_text(colour="black"),
        legend.text=element_text(size=16))

ggsave("Output/Appendix/figureG4.pdf",
       heatmap,
       width = 200, height = 175, units = "mm")

### Table G8: Do the treatments accentuate the effect of misperceptions on inheritance tax preferences? ----

df.wide <- df.wide %>%
  mutate(treated = case_when(Qtreatment == "1" ~ 0,
                             Qtreatment == "2" ~ 1,
                             Qtreatment == "3" ~ 1),
         house_misperception = perception_val_hou - quintile_val_hou)           # high = overestimate

m1 <- lm(inh_overalld ~ treated*house_misperception+house_rent_groups, 
         data=df.wide)

m2 <- lm(inh_you_payd ~ treated*house_misperception+house_rent_groups, 
         data=df.wide)

m3 <- lm(inh_heirs_payd ~ treated*house_misperception+house_rent_groups, 
         data=df.wide)

m4 <- lm(inh_lowd ~ treated*house_misperception+house_rent_groups,
         data=df.wide)

m5 <- lm(inh_moderated ~ treated*house_misperception+house_rent_groups,
         data=df.wide)

m6 <- lm(inh_highd ~ treated*house_misperception+house_rent_groups,
         data=df.wide)

stargazer(m1,m2,m3,m4,m5,m6, type="latex",
          title = "Do the treatments accentuate the effect of misperceptions on inheritance tax preferences?",
          dep.var.labels = c("Overall level", "You might pay", "Your heirs might pay", "<£325k", "£325k-?1m", ">£1m"),
          model.names = FALSE,
          no.space=TRUE,
          omit = "house_rent_groups",
          keep.stat = c("n","rsq"), 
          star.char = c("*"), star.cutoffs = c(0.05))

###
## Appendix H: Replication of Results with New Survey ----
###

### Figure H1: Preferences over inheritance taxation ----

df_control <- filter(df.experiment,framing_treatment == "Control")

p1 <- plot_canvas_figure1(df = df.experiment, q = df.experiment$inh_overall_recoded, labs = "Overall level", ylimits = c(0, .5)) 
p2 <- plot_canvas_figure1(df = df.experiment, q = df.experiment$inh_you_recoded, labs = "Tax you might pay", ylimits = c(0, .5))
p3 <- plot_canvas_figure1(df = df.experiment, q = df.experiment$inh_heirs_recoded, labs = "Tax your heirs might pay", ylimits = c(0, .5))
p4 <- plot_canvas_figure1(df = df.experiment, q = df.experiment$inh_low_recoded, labs = "Inheritances under £325k", ylimits = c(0, .5))
p5 <- plot_canvas_figure1(df = df.experiment, q = df.experiment$inh_mid_recoded, labs = "Inheritances £325k-£1m", ylimits = c(0, .5))
p6 <- plot_canvas_figure1(df = df.experiment, q = df.experiment$inh_high_recoded, labs = "Inheritances above £1m", ylimits = c(0, .5))

p.all <- gridExtra::grid.arrange(p1, p2, p3, p4, p5, p6, ncol=3)

ggsave("Output/Appendix/figureH1.pdf",
       p.all,
       width = 550, height = 275, units = "mm")

### Table H1: Determinants of registering an opinion on question about overall inheritance tax rates ----

# Linear

dk2_LPM <- lm(inh_overall_dk ~ as.factor(house_rent_groups)+as.factor(house_rent_groups_parents_5groups)+hh_income+age+relevel(gender,ref="Male")+degree+
                framing_treatment, 
              data=df.experiment)

# Logistic

dk2_logit <- glm(inh_overall_dk ~ as.factor(house_rent_groups)+as.factor(house_rent_groups_parents_5groups)+hh_income+age+relevel(gender,ref="Male")+degree+
                   framing_treatment, 
                 data=df.experiment, family=binomial(link="logit"))

# Table

stargazer(dk2_LPM, dk2_logit,  type="latex",
          title = "Determinants of registering an opinion on question about overall inheritance tax rates",
          model.names = FALSE,
          keep.stat = c("n", "rsq"), 
          covariate.labels = c("/hspace{2mm} £100k and under",
                               "/hspace{2mm} £100k to £200k",
                               "/hspace{2mm} £200k to £300k",
                               "/hspace{2mm} £300k to £400k",
                               "/hspace{2mm} £400k to £500k",
                               "/hspace{2mm} £500k to £750k",
                               "/hspace{2mm} £750k and up",
                               "/hspace{2mm} Not applicable/deceased",
                               "/hspace{2mm} £200k and under",
                               "/hspace{2mm} £200k to £400k",
                               "/hspace{2mm} £400k to £600k",
                               "/hspace{2mm} £600k and up",
                               "/hspace{2mm} Household income",
                               "/hspace{2mm} Age",
                               "/hspace{2mm} Female",
                               "/hspace{2mm} University degree",
                               "/hspace{2mm} Double Taxation",
                               "/hspace{2mm} Levelling Playing Field",
                               "/hspace{2mm} Spending and Tax Cuts"),
          no.space=TRUE,
          star.char = c("*"), star.cutoffs = c(0.05))

### Figure H2: The Effect of Current and Future Housing Wealth on Preferences over Inheritance Taxation, Replicating Results in Main Paper with Data from Follow-up Survey ----

# Left side

inh_overall_2 <- lm(inh_overall_d ~ as.factor(house_rent_groups)+as.factor(house_rent_groups_parents_5groups)+hh_income+age+relevel(gender,ref="Male")+degree+
                      framing_treatment, 
                    data=df.experiment)

inh_you_pay_2 <- lm(inh_you_d ~ as.factor(house_rent_groups)+as.factor(house_rent_groups_parents_5groups)+hh_income+age+relevel(gender,ref="Male")+degree+
                      framing_treatment, 
                    data=df.experiment)

inh_heirs_pay_2 <- lm(inh_heirs_d ~ as.factor(house_rent_groups)+as.factor(house_rent_groups_parents_5groups)+hh_income+age+relevel(gender,ref="Male")+degree+
                        framing_treatment, 
                      data=df.experiment)

inh_low_2 <- lm(inh_low_d ~ as.factor(house_rent_groups)+as.factor(house_rent_groups_parents_5groups)+hh_income+age+relevel(gender,ref="Male")+degree+
                  framing_treatment, 
                data=df.experiment)

inh_moderate_2 <- lm(inh_mid_d ~ as.factor(house_rent_groups)+as.factor(house_rent_groups_parents_5groups)+hh_income+age+relevel(gender,ref="Male")+degree+
                       framing_treatment, 
                     data=df.experiment)

inh_high_2 <- lm(inh_high_d ~ as.factor(house_rent_groups)+as.factor(house_rent_groups_parents_5groups)+hh_income+age+relevel(gender,ref="Male")+degree+
                   framing_treatment, 
                 data=df.experiment)

inh_overall_2_tidy <- inh_overall_2 %>% tidy()

coef_inh_overall_2 <- getcoef(model_name = "Overall level", reg = inh_overall_2_tidy)

inh_you_pay_2_tidy <- inh_you_pay_2 %>% tidy()

coef_inh_you_pay_2 <- getcoef(model_name = "You pay", reg = inh_you_pay_2_tidy)

inh_heirs_pay_2_tidy <- inh_heirs_pay_2 %>% tidy()

coef_inh_heirs_pay_2 <- getcoef(model_name = "Heirs pay", reg = inh_heirs_pay_2_tidy)

coefcombined_figure5 <- rbind(coef_inh_overall_2,coef_inh_you_pay_2,coef_inh_heirs_pay_2) %>%
  mutate(group = factor(group, levels = c("Overall level","You pay","Heirs pay")))

figH2_left <- plot_canvas_coefficient(df = coefcombined_figure5,
                                       face = coefcombined_figure5$bold,
                                       x = reorder(coefcombined_figure5$model, desc(coefcombined_figure5$model)),
                                       models = reorder(coefcombined_figure5$group, desc(coefcombined_figure5$group)),
                                       cols = threecolours) + ylim(-0.22,0.4) + labs(y="Coefficient estimate")

## Low, middle, and high inheritances

# Figure 6 - Linear

inh_low_2_tidy <- inh_low_2 %>% tidy()

coef_inh_low_2 <- getcoef(model_name = "<£325k", reg = inh_low_2_tidy)

inh_moderate_2_tidy <- inh_moderate_2 %>% tidy()

coef_inh_moderate_2 <- getcoef(model_name = "£325k-£1m", reg = inh_moderate_2_tidy)

inh_high_2_tidy <- inh_high_2 %>% tidy()

coef_inh_high_2 <- getcoef(model_name = ">£1m", reg = inh_high_2_tidy)

# Coef combined

coefcombined_figure6 <- rbind(coef_inh_low_2,coef_inh_moderate_2,coef_inh_high_2) %>%
  mutate(group = factor(group, levels = c("<£325k","£325k-£1m",">£1m")))

figH2_right <- plot_canvas_coefficient(df = coefcombined_figure6,
                                       face = coefcombined_figure6$bold,
                                       x = reorder(coefcombined_figure6$model, desc(coefcombined_figure6$model)),
                                       models = reorder(coefcombined_figure6$group, desc(coefcombined_figure6$group)),
                                       cols = threecolours)+ ylim(-0.22,0.4) + labs(y="Coefficient estimate")

figureH2 <- gridExtra::grid.arrange(figH2_left, figH2_right, ncol=2)

ggsave("Output/Appendix/figureH2.pdf",
       figureH2,
       width = 800, height = 600, units = "mm")

###
## Appendix I: Information Experiment II: Explanatory Information ----
###

### Table I1: Balance Tests, Follow-Up Experiment ----

covs2 <- subset(df.experiment, select = c(age,gender,hh_income,homeowner,degree,parent_homeowner,house_rent_groups,house_rent_groups_parents))
bal.tab(covs2, treat = df.experiment$framing_treatment, thresholds = c(m = .1)) 

### Table I2: Are people more likely to registering an opinion in the vignette treatment groups? ----

inh_overall_dk_linear <- lm_robust(inh_overall_dk ~ framing_treatment + info_treatment, data = df.experiment)
inh_you_dk_linear <- lm_robust(inh_you_dk ~ framing_treatment + info_treatment, data = df.experiment)
inh_heirs_dk_linear <- lm_robust(inh_heirs_dk ~ framing_treatment + info_treatment, data = df.experiment)
inh_low_dk_linear <- lm_robust(inh_low_dk ~ framing_treatment + info_treatment, data = df.experiment)
inh_mid_dk_linear <- lm_robust(inh_mid_dk ~ framing_treatment + info_treatment, data = df.experiment)
inh_high_dk_linear <- lm_robust(inh_high_dk ~ framing_treatment + info_treatment, data = df.experiment)

texreg(list(inh_overall_dk_linear,
            inh_you_dk_linear,
            inh_heirs_dk_linear,
            inh_low_dk_linear,
            inh_mid_dk_linear,
            inh_high_dk_linear),
       stars = 0.05,
       custom.model.names = c("Overall level", "You might pay", "Your heirs might pay", "<\\textsterling325k",
                              "\\textsterling325k-\\textsterling1m", ">\\textsterling1m"),
       custom.coef.names = c("Constant",
                             "Death/Double tax", 
                             "Equality of opportunity", 
                             "Taxes and public goods"
       ),
       caption = "Are people more likely to registering an opinion?",
       caption.above = TRUE,
       include.nobs = TRUE,
       include.rsquared = TRUE,
       include.adjrs = FALSE,
       include.rmse = FALSE,
       include.ci = FALSE,
       reorder.coef = c(2,3,4,1),
       omit.coef=c('info_treatment'),
       custom.note = "%stars. Linear probability model. Dependent variable is whether the respondent thinks that taxes are (much) too high. ",
       digits = 3
)

# Pooled regression

comb_overall <- df.experiment %>% dplyr::select(tax = inh_overall_d,dk = inh_overall_dk,framing_treatment,info_treatment,house_rent_groups_parents2,homeowner,ID) %>% 
  mutate(group = "inh_overall_d")

comb_you <- df.experiment %>% dplyr::select(tax = inh_you_d, dk = inh_you_dk, framing_treatment,info_treatment,house_rent_groups_parents2,homeowner,ID) %>% 
  mutate(group = "inh_you_d")

comb_heirs <- df.experiment %>% dplyr::select(tax = inh_heirs_d, dk = inh_heirs_dk, framing_treatment,info_treatment,house_rent_groups_parents2,homeowner,ID) %>% 
  mutate(group = "inh_heirs_d")

comb_low <- df.experiment %>% dplyr::select(tax = inh_low_d,dk = inh_low_dk, framing_treatment,info_treatment,house_rent_groups_parents2,homeowner,ID) %>% 
  mutate(group = "inh_low_d")

comb_mid <- df.experiment %>% dplyr::select(tax = inh_mid_d, dk = inh_mid_dk, framing_treatment,info_treatment,house_rent_groups_parents2,homeowner,ID) %>% 
  mutate(group = "inh_mid_d")

comb_high <- df.experiment %>% dplyr::select(tax = inh_high_d, dk = inh_high_dk, framing_treatment,info_treatment,house_rent_groups_parents2,homeowner,ID) %>% 
  mutate(group = "inh_high_d")

comb_all <- bind_rows(comb_overall,comb_you,comb_heirs,comb_low,comb_mid,comb_high)

cond_all_dk <- lm_robust(dk ~ framing_treatment + info_treatment, data = comb_all, clusters = ID) 

texreg(list(cond_all_dk),
       stars = c(0.05,0.1),
       custom.model.names = c("Pooled Regression"),
       custom.coef.names = c("Constant",
                             "Death/Double tax", 
                             "Equality of opportunity", 
                             "Taxes and public goods"
       ),
       caption = "Pooled analysis",
       caption.above = TRUE,
       include.nobs = TRUE,
       include.rsquared = TRUE,
       include.adjrs = FALSE,
       include.rmse = FALSE,
       include.ci = FALSE,
       custom.note = "%stars. Linear probability model. Dependent variable is whether the respondent registers an opinion.",
       scalebox = .75,
       use.packages = FALSE,
       omit.coef = "info_treatment"
)

### Figure I1: The Follow-Up Treatment Had an Effect on Whether Respondents Register An Opinion Conditional on Own (Top) and Parents' (Bottom) Homeownership Status ----

### Homeowners

## Don't know

# Overall level

cond_ownhouse_overall_dk <- lm(inh_overall_dk ~ framing_treatment*homeowner + info_treatment,data=df.experiment)

ownhouse_overall_dk_out <- contrast_conditional(reg = cond_ownhouse_overall_dk,facettext = "Overall level")

# You

cond_ownhouse_you_dk <- lm(inh_you_dk ~ framing_treatment*homeowner + info_treatment, data = df.experiment)

ownhouse_you_dk_out <- contrast_conditional(reg = cond_ownhouse_you_dk,facettext = "You might pay")

# Heirs pay

cond_ownhouse_heirs_dk <- lm(inh_heirs_dk ~ framing_treatment*homeowner + info_treatment, data = df.experiment)

ownhouse_heirs_dk_out <- contrast_conditional(reg = cond_ownhouse_heirs_dk,facettext = "Your heirs might pay")

# <£325k

cond_ownhouse_low_dk <- lm(inh_low_dk ~ framing_treatment*homeowner + info_treatment, data = df.experiment)

ownhouse_low_dk_out <- contrast_conditional(reg = cond_ownhouse_low_dk,facettext = "<£325k")

# £325k-£1m

cond_ownhouse_mid_dk <- lm(inh_mid_dk ~ framing_treatment*homeowner + info_treatment, data = df.experiment)

ownhouse_mid_dk_out <- contrast_conditional(reg = cond_ownhouse_mid_dk,facettext = "£325k-£1m")

# >1£m

cond_ownhouse_high_dk <- lm(inh_high_dk ~ framing_treatment*homeowner + info_treatment, data = df.experiment) 

ownhouse_high_dk_out <- contrast_conditional(reg = cond_ownhouse_high_dk,facettext = ">£1m")

# Bind results

cond <- rbind(ownhouse_overall_dk_out,ownhouse_you_dk_out,ownhouse_heirs_dk_out,ownhouse_low_dk_out,ownhouse_mid_dk_out,ownhouse_high_dk_out) %>% 
  mutate(model = fct_relevel(model,c("Taxes and public goods","Equality of opportunity","Death/Double tax")),
         group = fct_relevel(group,c("Own","Don't own")),
         facet = fct_relevel(facettext,c("Overall level","You might pay","Your heirs might pay","<£325k","£325k-£1m",">£1m")))

# Plot

plot_home_dk <- plot_canvas_coefficient_experiment(df = cond)

### Parents

## Don't know

# Overall level

cond_parents_overall_dk <- lm(inh_overall_dk ~ framing_treatment*house_rent_groups_parents2 + info_treatment, 
                              data=df.experiment)

parents_overall_dk_out <- contrast_conditional(reg = cond_parents_overall_dk,facettext = "Overall level",parents = TRUE)

# You

cond_parents_you_dk <- lm(inh_you_dk ~ framing_treatment*house_rent_groups_parents2 + info_treatment, data = df.experiment)

parents_you_dk_out <- contrast_conditional(reg = cond_parents_you_dk,facettext = "You might pay",parents = TRUE)

# Heirs pay

cond_parents_heirs_dk <- lm(inh_heirs_dk ~ framing_treatment*house_rent_groups_parents2 + info_treatment, data = df.experiment)

parents_heirs_dk_out <- contrast_conditional(reg = cond_parents_heirs_dk,facettext = "Your heirs might pay",parents = TRUE)

# <£325k

cond_parents_low_dk <- lm(inh_low_dk ~ framing_treatment*house_rent_groups_parents2 + info_treatment, data = df.experiment)

parents_low_dk_out <- contrast_conditional(reg = cond_parents_low_dk,facettext = "<£325k",parents = TRUE)

# £325k-£1m

cond_parents_mid_dk <- lm(inh_mid_dk ~ framing_treatment*house_rent_groups_parents2 + info_treatment, data = df.experiment)

parents_mid_dk_out <- contrast_conditional(reg = cond_parents_mid_dk,facettext = "£325k-£1m",parents = TRUE)

# >1£m

cond_parents_high_dk <- lm(inh_high_dk ~ framing_treatment*house_rent_groups_parents2 + info_treatment, data = df.experiment) 

parents_high_dk_out <- contrast_conditional(reg = cond_parents_high_dk,facettext = ">£1m",parents = TRUE)

summary(cond_parents_high_dk)

# Bind results

cond <- rbind(parents_overall_dk_out,parents_you_dk_out,parents_heirs_dk_out,parents_low_dk_out,parents_mid_dk_out,parents_high_dk_out) %>% 
  mutate(model = fct_relevel(model,c("Taxes and public goods","Equality of opportunity","Death/Double tax")),
         group = fct_relevel(group,c("Own","Not applicable/deceased","Don't own")),
         facet = fct_relevel(facettext,c("Overall level","You might pay","Your heirs might pay","<£325k","£325k-£1m",">£1m")))

# Plot

plot_parents_dk <- plot_canvas_coefficient_experiment(df = cond)

figureI1 <- gridExtra::grid.arrange(plot_home_dk, plot_parents_dk, ncol=1)

ggsave("Output/Appendix/figureI1.pdf",
       figureI1,
       width = 800, height = 600, units = "mm")

### Table I3: Determinants of thinking that inheritance taxes are (much) too high ----

# Overall

overall_LPM <- lm(inh_overall_d ~ as.factor(house_rent_groups)+as.factor(house_rent_groups_parents_5groups)+hh_income+age+relevel(gender,ref="Male")+degree+
                    party_ID + 
                    framing_treatment, 
                  data=df.experiment)

# You

you_LPM <- lm(inh_you_d ~ as.factor(house_rent_groups)+as.factor(house_rent_groups_parents_5groups)+hh_income+age+relevel(gender,ref="Male")+degree+
                party_ID + 
                framing_treatment, 
              data=df.experiment)

# Heirs

heirs_LPM <- lm(inh_heirs_d ~ as.factor(house_rent_groups)+as.factor(house_rent_groups_parents_5groups)+hh_income+age+relevel(gender,ref="Male")+degree+
                  party_ID + 
                  framing_treatment, 
                data=df.experiment)

# Low

low_LPM <- lm(inh_low_d ~ as.factor(house_rent_groups)+as.factor(house_rent_groups_parents_5groups)+hh_income+age+relevel(gender,ref="Male")+degree+
                party_ID + 
                framing_treatment, 
              data=df.experiment)

# Middle

mid_LPM <- lm(inh_mid_d ~ as.factor(house_rent_groups)+as.factor(house_rent_groups_parents_5groups)+hh_income+age+relevel(gender,ref="Male")+degree+
                party_ID + 
                framing_treatment, 
              data=df.experiment)

# High

high_LPM <- lm(inh_high_d ~ as.factor(house_rent_groups)+as.factor(house_rent_groups_parents_5groups)+hh_income+age+relevel(gender,ref="Male")+degree+
                 party_ID + 
                 framing_treatment, 
               data=df.experiment)

# Table

stargazer(overall_LPM, you_LPM, heirs_LPM, low_LPM, mid_LPM, high_LPM,  type="latex",
          title = "Determinants of thinking that The Overall Level of Inheritance Taxes are (much) too high",
          dep.var.labels = c("Overall level", "You pay", "Heirs pay", "Overall level", "You pay", "Heirs pay"),
          model.names = FALSE,
          keep.stat = c("n", "rsq"), 
          covariate.labels = c("/hspace{2mm} £100k and under",
                               "/hspace{2mm} £100k to £200k",
                               "/hspace{2mm} £200k to £300k",
                               "/hspace{2mm} £300k to £400k",
                               "/hspace{2mm} £400k to £500k",
                               "/hspace{2mm} £500k to £750k",
                               "/hspace{2mm} £750k and up",
                               "/hspace{2mm} Not applicable/deceased",
                               "/hspace{2mm} £200k and under",
                               "/hspace{2mm} £200k to £400k",
                               "/hspace{2mm} £400k to £600k",
                               "/hspace{2mm} £600k and up",
                               "/hspace{2mm} Household income",
                               "/hspace{2mm} Age",
                               "/hspace{2mm} Female",
                               "/hspace{2mm} University degree",
                               "/hspace{2mm} Labour",
                               "/hspace{2mm} Other/Don't know",
                               "/hspace{2mm} Double Taxation",
                               "/hspace{2mm} Levelling Playing Field",
                               "/hspace{2mm} Spending and Tax Cuts"),
          no.space=TRUE,
          star.char = c("*"), star.cutoffs = c(0.05))

### Figure I2: The Effect of the Follow-Up Treatment on Inheritance Tax Preferences, by Past Vote ----

# Overall level

cond_parents_overall_d <- lm(inh_overall_d ~ framing_treatment*party_ID + info_treatment, 
                             data=df.experiment)

parents_overall_d_out <- contrast_conditional(reg = cond_parents_overall_d,facettext = "Overall level",parents = FALSE, party_ID = TRUE)

# You

cond_parents_you_d <- lm(inh_you_d ~ framing_treatment*party_ID + info_treatment, data = df.experiment)

parents_you_d_out <- contrast_conditional(reg = cond_parents_you_d,facettext = "You might pay",parents = FALSE, party_ID = TRUE)

# Heirs pay

cond_parents_heirs_d <- lm(inh_heirs_d ~ framing_treatment*party_ID + info_treatment, data = df.experiment)

parents_heirs_d_out <- contrast_conditional(reg = cond_parents_heirs_d,facettext = "Your heirs might pay",parents = FALSE, party_ID = TRUE)

# <£325k

cond_parents_low_d <- lm(inh_low_d ~ framing_treatment*party_ID + info_treatment, data = df.experiment)

parents_low_d_out <- contrast_conditional(reg = cond_parents_low_d,facettext = "<£325k",parents = FALSE, party_ID = TRUE)

# £325k-£1m

cond_parents_mid_d <- lm(inh_mid_d ~ framing_treatment*party_ID + info_treatment, data = df.experiment)

parents_mid_d_out <- contrast_conditional(reg = cond_parents_mid_d,facettext = "£325k-£1m",parents = FALSE, party_ID = TRUE)

# >1£m

cond_parents_high_d <- lm(inh_high_d ~ framing_treatment*party_ID + info_treatment, data = df.experiment) 

parents_high_d_out <- contrast_conditional(reg = cond_parents_high_d,facettext = ">£1m",parents = FALSE, party_ID = TRUE)

nobs(cond_parents_high_d)

# Bind results

cond <- rbind(parents_overall_d_out,parents_you_d_out,parents_heirs_d_out,parents_low_d_out,parents_mid_d_out,parents_high_d_out) %>% 
  mutate(model = fct_relevel(model,c("Taxes and public goods","Equality of opportunity","Death/Double tax")),
         group = fct_relevel(group,c("Conservative","Labour","Other/Don't know")),
         facettext = factor(facettext,levels=c("Overall level","You might pay","Your heirs might pay","<£325k","£325k-£1m",">£1m")))

# Plot

plot_pastvote_d <- plot_canvas_coefficient_experiment(df = cond)

ggsave("Output/Appendix/figureI2.pdf",
       plot_pastvote_d,
       width = 600, height = 350, units = "mm")

### Table I4: Table for Figure 10 ----

inh_overall_d_linear <- lm_robust(inh_overall_d ~ framing_treatment + info_treatment, data = df.experiment)
inh_you_d_linear <- lm_robust(inh_you_d ~ framing_treatment + info_treatment, data = df.experiment)
inh_heirs_d_linear <- lm_robust(inh_heirs_d ~ framing_treatment + info_treatment, data = df.experiment)
inh_low_d_linear <- lm_robust(inh_low_d ~ framing_treatment + info_treatment, data = df.experiment)
inh_mid_d_linear <- lm_robust(inh_mid_d ~ framing_treatment + info_treatment, data = df.experiment)
inh_high_d_linear <- lm_robust(inh_high_d ~ framing_treatment + info_treatment, data = df.experiment)

texreg(list(inh_overall_d_linear,
            inh_you_d_linear,
            inh_heirs_d_linear,
            inh_low_d_linear,
            inh_mid_d_linear,
            inh_high_d_linear),
       stars = 0.05,
       custom.model.names = c("Overall level", "You might pay", "Your heirs might pay", "<\\textsterling325k",
                              "\\textsterling325k-\\textsterling1m", ">\\textsterling1m"),
       custom.coef.names = c("Constant",
                             "Death/Double tax", 
                             "Equality of opportunity", 
                             "Taxes and public goods"
       ),
       caption = "Are people more likely to find that inheritance taxes are too high?",
       caption.above = TRUE,
       include.nobs = TRUE,
       include.rsquared = TRUE,
       include.adjrs = FALSE,
       include.rmse = FALSE,
       include.ci = FALSE,
       reorder.coef = c(2,3,4,1),
       omit.coef=c('info_treatment'),
       custom.note = "%stars. Linear probability model. Dependent variable is whether the respondent thinks that taxes are (much) too high. "
)

# Pooled regression

cond_all<- lm_robust(tax ~ framing_treatment + info_treatment, data = comb_all, clusters = ID) 

texreg(list(cond_all),
       stars = c(0.05,0.1),
       custom.model.names = c("Pooled Regression"),
       custom.coef.names = c("Constant",
                             "Death/Double tax", 
                             "Equality of opportunity", 
                             "Taxes and public goods"
       ),
       caption = "Pooled analysis",
       caption.above = TRUE,
       include.nobs = TRUE,
       include.rsquared = TRUE,
       include.adjrs = FALSE,
       include.rmse = FALSE,
       include.ci = FALSE,
       custom.note = "%stars. Linear probability model. Dependent variable is whether the respondent thinks that taxes are (much) too high.",
       scalebox = .75,
       use.packages = FALSE,
       omit.coef = "info_treatment"
)

### Table I5: Table for Top Panel of Figure 11 ----

cond_ownhouse_overall_d <- lm(inh_overall_d ~ framing_treatment*homeowner,data=df.experiment)
cond_ownhouse_you_d <- lm(inh_you_d ~ framing_treatment*homeowner, data = df.experiment)
cond_ownhouse_heirs_d <- lm(inh_heirs_d ~ framing_treatment*homeowner, data = df.experiment)
cond_ownhouse_low_d <- lm(inh_low_d ~ framing_treatment*homeowner, data = df.experiment)
cond_ownhouse_mid_d <- lm(inh_mid_d ~ framing_treatment*homeowner, data = df.experiment)
cond_ownhouse_high_d <- lm(inh_high_d ~ framing_treatment*homeowner, data = df.experiment) 

texreg(list(cond_ownhouse_overall_d, 
            cond_ownhouse_you_d,
            cond_ownhouse_heirs_d,
            cond_ownhouse_low_d,
            cond_ownhouse_mid_d,
            cond_ownhouse_high_d),
       stars = c(0.05, 0.1),
       digits = 2,
       custom.model.names = c("Overall level", "You might pay", "Your heirs might pay", "$<$£325k",
                              "£325k-£1m", "$>$£1m"),
       custom.coef.names = c("Constant",
                             "Death/Double tax", 
                             "Equality of opportunity", 
                             "Taxes and public goods",
                             "Homeowner",
                             "Double Taxation X homeowner",
                             "Equality of opportunity X homeowner",
                             "Taxes and public goods X homeowner"),
       caption = "Table for Top Panel of Figure ref{fig:cond_d2}",
       caption.above = TRUE,
       include.nobs = TRUE,
       include.rsquared = TRUE,
       include.adjrs = FALSE,
       include.rmse = FALSE,
       include.ci = FALSE,
       omit.coef=c('info_treatment'),
       custom.note = "%stars. Linear probability model. Dependent variable is whether the respondent thinks that taxes are (much) too high"
)

# Pooled regression

cond_all_own <- lm_robust(tax ~ framing_treatment*homeowner + info_treatment, data = comb_all, clusters = ID) 

texreg(list(cond_all_own),
       stars = c(0.05,0.1),
       custom.model.names = c("Pooled Regression"),
       custom.coef.names = c("Constant",
                             "Death/Double tax", 
                             "Equality of opportunity", 
                             "Taxes and public goods",
                             "Homeowner",
                             "Double Taxation X homeowner",
                             "Equality of opportunity X homeowner",
                             "Taxes and public goods X homeowner"
       ),
       caption = "Table for Top Panel of Figure ",
       caption.above = TRUE,
       include.nobs = TRUE,
       include.rsquared = TRUE,
       include.adjrs = FALSE,
       include.rmse = FALSE,
       include.ci = FALSE,
       custom.note = "%stars. Linear probability model. Dependent variable is whether the respondent thinks that taxes are (much) too high.",
       scalebox = .75,
       use.packages = FALSE,
       omit.coef = "info_treatment"
)

### Table I6: Table for Bottom Panel of Figure and the Pooled Regression 11 ----

cond_parents_overall_d <- lm(inh_overall_d ~ framing_treatment*house_rent_groups_parents2,data=df.experiment)
cond_parents_you_d <- lm(inh_you_d ~ framing_treatment*house_rent_groups_parents2, data = df.experiment)
cond_parents_heirs_d <- lm(inh_heirs_d ~ framing_treatment*house_rent_groups_parents2, data = df.experiment)
cond_parents_low_d <- lm(inh_low_d ~ framing_treatment*house_rent_groups_parents2, data = df.experiment)
cond_parents_mid_d <- lm(inh_mid_d ~ framing_treatment*house_rent_groups_parents2, data = df.experiment)
cond_parents_high_d <- lm(inh_high_d ~ framing_treatment*house_rent_groups_parents2, data = df.experiment) 

texreg(list(cond_parents_overall_d, 
            cond_parents_you_d,
            cond_parents_heirs_d,
            cond_parents_low_d,
            cond_parents_mid_d,
            cond_parents_high_d),
       stars = c(0.05, 0.1),
       digits = 2,
       custom.model.names = c("Overall level", "You might pay", "Your heirs might pay", "$<$£325k",
                              "£325k-£1m", "$>$£1m"),
       custom.coef.names = c("Constant",
                             "Death/Double tax", 
                             "Equality of opportunity", 
                             "Taxes and public goods",
                             "NA/deceased",
                             "Homeowner",
                             "Double Taxation X NA/deceased",
                             "Equality of opportunity X NA/deceased",
                             "Taxes and public goods X NA/deceased",
                             "Double Taxation X homeowner",
                             "Equality of opportunity X homeowner",
                             "Taxes and public goods X homeowner"),
       
       caption = "Table for Bottom Panel of Figure ref{fig:cond_d2}",
       caption.above = TRUE,
       include.nobs = TRUE,
       include.rsquared = TRUE,
       include.adjrs = FALSE,
       include.rmse = FALSE,
       include.ci = FALSE,
       omit.coef=c('info_treatment'),
       custom.note = "%stars. Linear probability model. Dependent variable is whether the respondent thinks that taxes are (much) too high"
)

# Pooled regression

cond_all_parents <- lm_robust(tax ~ framing_treatment*house_rent_groups_parents2 + info_treatment, data = comb_all, clusters = ID) 

# Output

texreg(list(cond_all_parents),
       stars = c(0.05,0.1),
       custom.model.names = c("Pooled regression"),
       custom.coef.names = c("Constant",
                             "Death/Double tax", 
                             "Equality of opportunity", 
                             "Taxes and public goods",
                             "Not applicable/deceased",
                             "Own",
                             "Double Taxation X Not applicable/deceased",
                             "Equality of opportunity X Not applicable/deceased",
                             "Taxes and public goods X Not applicable/deceased",
                             "Double Taxation X Own",
                             "Equality of opportunity X Own",
                             "Taxes and public goods X Own"
       ),
       caption = "Are people more likely to register an opinion dependent on their parents' wealth?",
       caption.above = TRUE,
       include.nobs = TRUE,
       include.rsquared = TRUE,
       include.adjrs = FALSE,
       include.rmse = FALSE,
       include.ci = FALSE,
       custom.note = "%stars. Linear probability model. Dependent variable is whether the respondent thinks that taxes are (much) too high.",
       scalebox = .75,
       use.packages = FALSE,
       omit.coef = "info_treatment"
)